source: trunk/dasscm/dasscm@ 256

Last change on this file since 256 was 256, checked in by joergs, on Dec 23, 2008 at 10:02:12 AM

added comment

  • Property keyword set to id
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 25.1 KB
Line 
1#!/usr/bin/perl -w
2
3# $Id: dasscm 256 2008-12-23 09:02:12Z joergs $
4
5use strict;
6
7use Env
8 qw($DASSCM_PROD $DASSCM_REPO $USER $DASSCM_USERNAME $DASSCM_USER $DASSCM_PASSWORD $SHELL);
9use Cwd;
10use Getopt::Long;
11use File::Basename;
12use File::Compare;
13use File::Copy;
14use File::Find;
15use File::stat;
16use File::Path;
17use Term::ReadKey;
18
19#use Data::Dumper;
20
21#####################################################################
22#
23# global
24#
25
26# shell exit codes
27my $RETURN_OK = 0;
28my $RETURN_NOK = 1;
29
30# file to store permissions
31my $permissions_file = "/etc/permissions.d/dasscm.permission_backup";
32
33# documentation file (for usage)
34my $doc_file = "/usr/share/doc/packages/dasscm/dasscm_howto.txt";
35
36# commands that require write access (and therefore a login)
37# to the repository server
38my @COMMANDS_REQUIRE_WRITE = ( "add", "commit" );
39
40# configuration file
41my $config_file = "/etc/dasscm.conf";
42my $config = get_config($config_file);
43my $DASSCM_LOCAL_REPOSITORY_BASE;
44my $DASSCM_REPOSITORY_NAME;
45my $DASSCM_SVN_REPOSITORY;
46my $DASSCM_CHECKOUT_USERNAME;
47my $DASSCM_CHECKOUT_PASSWORD;
48
49# current directory at program start
50my $StartDirectory = cwd();
51
52my $SVN = "svn ";
53my $svnOptions = "";
54my $svnCheckoutCredentials = "";
55my $svnPasswordCredentials = "";
56my $diff = "diff --exclude .svn ";
57
58# command line options get stored in options hash
59my %options = ();
60
61# subcommand, that gets executed (add, commit, ...)
62my $command;
63
64my $verbose = 0;
65
66#####################################################################
67#
68# util functions
69#
70sub usage()
71{
72 print "usage: dasscm <subcommand> [options] [args]\n";
73 print "\n";
74 print "dasscm is intended to help versioning configuration files\n";
75 print "\n";
76 print "Available subcommands:\n";
77 print " help <subcommand>\n";
78 print " init\n";
79 print " login\n";
80 print " up\n";
81 print " ls\n";
82 print " add <filename>\n";
83 print " commit <filename>\n";
84 print " diff <filename>\n";
85 print " status\n";
86 print " permissions\n";
87 print "\n";
88 print "preparation:\n", " if dasscm is already configured,\n",
89 " use 'dasscm login' and then eg. 'add'.\n",
90 " The environment variables\n", " DASSCM_REPO\n", " DASSCM_PROD\n",
91 " DASSCM_USERNAME\n", " DASSCM_PASSWORD\n",
92 " are evaluated, but set automatically by 'dasscm login'.\n", "\n",
93 " If dasscm is not yet configured, read", " $doc_file\n";
94}
95
96sub warning(@)
97{
98 print "Warning: " . join( "\n ", @_ ) . "\n";
99}
100
101sub error(@)
102{
103 print "Error: " . join( "\n ", @_ ) . "\n";
104}
105
106sub fatalerror(@)
107{
108 error(@_);
109
110 #print "Exiting\n";
111 exit 1;
112}
113
114#
115# reading config file and return key/value pairs as hash
116#
117sub get_config
118{
119 my $file = $_[0];
120
121 if ( !$file ) {
122 fatalerror( "failed to open config file" . $file );
123 }
124
125 my $data = {};
126
127 # try to open config file
128 if ( !open( FH, $file ) ) {
129 fatalerror( "failed to open config file" . $file );
130 } else {
131 while (<FH>) {
132 chomp;
133 if (/^#/) {
134 next;
135 }
136 if ( $_ =~ /=/g ) {
137
138 # splitting in 2 fields at maximum
139 my ( $option, $value ) = split( /=/, $_, 2 );
140 $option =~ s/^\s+//g;
141 $option =~ s/\s+$//g;
142 $option =~ s/\"+//g;
143 $value =~ s/^\s+//g;
144 $value =~ s/\s+$//g;
145 $value =~ s/\"+//g;
146
147 if ( length($option) ) {
148 $data->{$option} = $value;
149 }
150 }
151 }
152 }
153 close(FH);
154
155 return $data;
156}
157
158sub check_env()
159{
160
161 # DASSCM_PROD
162 if ( !$DASSCM_PROD ) {
163 $DASSCM_PROD = "/";
164 }
165
166 if ( !-d $DASSCM_PROD ) {
167 die "DASSCM_PROD ($DASSCM_PROD) is not set to a directory.\n";
168 }
169 if ($verbose) { print "DASSCM_PROD: " . $DASSCM_PROD . "\n"; }
170
171 # DASSCM_REPOSITORY_NAME
172 if ( !$DASSCM_REPOSITORY_NAME ) {
173 die
174 "Variable DASSCM_REPOSITORY_NAME is not defined.\nIt needs to be a unique name.\nNormally the full qualified host name is used.\nUse file $config_file to configure it.\n";
175 }
176
177 # DASSCM_REPO
178 if ( !$DASSCM_REPO ) {
179 if ( $DASSCM_LOCAL_REPOSITORY_BASE && $DASSCM_REPOSITORY_NAME ) {
180 $DASSCM_REPO =
181 $DASSCM_LOCAL_REPOSITORY_BASE . "/" . $DASSCM_REPOSITORY_NAME;
182 } else {
183 die
184 "Envirnonment variable DASSCM_REPO not set.\nSet DASSCM_REPO to the directory of the versioning system checkout for this machine.\n";
185 }
186 }
187 if ($verbose) { print "DASSCM_REPO: " . $DASSCM_REPO . "\n"; }
188
189 #
190 # subversion checkout user
191 #
192 if ( !$DASSCM_CHECKOUT_USERNAME ) {
193 fatalerror(
194 "variable DASSCM_CHECKOUT_USERNAME is not defined.",
195 "Use file $config_file to configure it."
196 );
197 }
198
199 if ( !$DASSCM_CHECKOUT_PASSWORD ) {
200 fatalerror(
201 "variable DASSCM_CHECKOUT_PASSWORD is not defined.",
202 "Use file $config_file to configure it."
203 );
204 }
205
206 #
207 # check if local repository directory exist
208 # (if not creating by init)
209 #
210 if ( $command ne "init" ) {
211 if ( not -d $DASSCM_REPO ) {
212 die
213 "Can't access local repository DASSCM_REPO\n($DASSCM_REPO)\nCheck configuration and execute\n dasscm init\n";
214 }
215
216 #
217 # user settings
218 #
219
220 # DASSCM_USER is legacy. Use DASSCM_USERNAME instead
221 if ( !$DASSCM_USERNAME ) {
222 $DASSCM_USERNAME = $DASSCM_USER;
223 }
224
225 # user root is not allowed for checkins.
226 # if user is root, DASSCM_USER has to be set,
227 # otherwise USER can be used
228 if ( "$USER" eq "root" ) {
229 if ( ( not $DASSCM_USERNAME )
230 and ( grep { m|^$command$| } @COMMANDS_REQUIRE_WRITE ) )
231 {
232
233 #( $command ne "login" ) and ( $command ne "status" ) ) {
234 fatalerror(
235 "Envirnonment variable DASSCM_USERNAME not set.",
236 "Set DASSCM_USERNAME to your subversion user account or",
237 "use 'dasscm login'"
238 );
239 }
240 $svnOptions .= " --no-auth-cache ";
241 } elsif ( !$DASSCM_USERNAME ) {
242 $DASSCM_USERNAME = $USER;
243 }
244
245 #
246 # password
247 #
248 if ($DASSCM_PASSWORD) {
249 $svnPasswordCredentials = " --password $DASSCM_PASSWORD ";
250 }
251 }
252
253 #$svnOptions .= " --username $DASSCM_USERNAME "
254}
255
256sub check_parameter(@)
257{
258}
259
260#
261# generate from (relative) filename
262# all required file and directory names:
263# $basename, $dirname_prod, $dirname_repo,
264# $filename_prod, $filename_repo
265#
266sub get_filenames(@)
267{
268 my $filename_prod = $_[0] || ".";
269
270 # make filename absolut
271 if ( !( $filename_prod =~ m/^\// ) ) {
272 $filename_prod = cwd() . "/" . $filename_prod;
273 }
274
275 if ( not -r $filename_prod ) {
276 fatalerror( $filename_prod . " is not accessable" );
277 }
278
279 # TODO: dirname buggy: eg. "/etc/" is reduced to "/",
280 # "/etc" is used as filename
281 my $dirname_prod = dirname($filename_prod);
282
283 # uses chdir to determine real directory in a unique way
284 chdir $dirname_prod or die $!;
285 $dirname_prod = cwd();
286 chdir $StartDirectory;
287
288 my $basename = basename($filename_prod);
289
290 if ($verbose) {
291 print "dir: " . $dirname_prod . "\n";
292 print "fn: " . $basename . "\n";
293 }
294
295 my $dirname_repo = $DASSCM_REPO . "/" . $dirname_prod;
296 my $filename_repo = "$dirname_repo/$basename";
297
298 return (
299 $basename, $dirname_prod, $dirname_repo,
300 $filename_prod, $filename_repo
301 );
302}
303
304
305
306#
307# creates a file with permissions
308#
309sub generatePermissionList
310{
311
312 # generieren der Zeilen für Permission-Savefile
313 my @files = @_;
314 my @permlist = ();
315 foreach my $file (@files) {
316 $file = "/" . $file;
317 if ( -e $file ) {
318 my $info = stat($file) || die "failed to stat $file: aborting";
319 my $mode = get_type( $info->mode ) & 07777;
320 my $modestring = sprintf( "%04o", $mode );
321 my $uid = $info->uid;
322 my $uidname = getpwuid($uid);
323 my $gid = $info->gid;
324 my $gidname = getgrgid($gid);
325 push(
326 @permlist,
327 sprintf( "%-55s %-17s %4d",
328 $file, "${uidname}:${gidname}", $modestring )
329 );
330 } else {
331 print
332 "failed to get status of $file. It exists in the repository, but not on the system\n";
333 }
334 }
335 return @permlist;
336}
337
338sub get_type
339{
340
341 # Funktion übernommen aus /usr/bin/chkstat
342 my $S_IFLNK = 0120000; # symbolic link
343 my $S_IFREG = 0100000; # regular file
344 my $S_IFDIR = 0040000; # directory
345 my $S_IFCHAR = 0020000; # character device
346 my $S_IFBLK = 0060000; # block device
347 my $S_IFFIFO = 0010000; # fifo
348 my $S_IFSOCK = 0140000; # socket
349 my $S_IFMT = 0170000; # type of file
350
351 my $S_m;
352 if ( ( $_[0] & $S_IFMT ) == $S_IFLNK ) { $S_m = $_[0] - $S_IFLNK; }
353 elsif ( ( $_[0] & $S_IFMT ) == $S_IFREG ) { $S_m = $_[0] - $S_IFREG; }
354 elsif ( ( $_[0] & $S_IFMT ) == $S_IFDIR ) { $S_m = $_[0] - $S_IFDIR; }
355 elsif ( ( $_[0] & $S_IFMT ) == $S_IFCHAR ) { $S_m = $_[0] - $S_IFCHAR; }
356 elsif ( ( $_[0] & $S_IFMT ) == $S_IFBLK ) { $S_m = $_[0] - $S_IFBLK; }
357 elsif ( ( $_[0] & $S_IFMT ) == $S_IFFIFO ) { $S_m = $_[0] - $S_IFFIFO; }
358 elsif ( ( $_[0] & $S_IFMT ) == $S_IFSOCK ) { $S_m = $_[0] - $S_IFSOCK; }
359 $S_m;
360}
361
362sub run_command
363{
364 my $command = shift;
365
366 #print "executing command: " . $command . "\n";
367
368 open( RESULT, $command . ' 2>&1 |' );
369 my @result = <RESULT>;
370 close(RESULT);
371 my $retcode = $? >> 8;
372
373 #print @result;
374 #if( $retcode ) { print "return code: " . $retcode . "\n"; }
375
376 return ( $retcode, @result );
377}
378
379sub run_interactive
380{
381
382 if ($verbose) {
383 print "run_interactive:" . join( " ", @_ ) . "\n";
384 }
385
386 system(@_);
387 if ( $? == -1 ) {
388 printf "failed to execute: $!\n";
389 } elsif ( $? & 127 ) {
390 printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
391 ( $? & 128 ) ? 'with' : 'without';
392 } elsif ( $? >> 8 != 0 ) {
393 printf "child exited with value %d\n", $? >> 8;
394 }
395 return ( $? >> 8 );
396}
397
398sub svn_check_credentials( $$;$$ )
399{
400 my $username = shift;
401 my $password = shift;
402
403 # check silently are allow user interaction?
404 my $interactive = shift || 0;
405
406 # default: exit program, if repository is not accessable
407 # (do not exit for 'init')
408 my $fatalerror = shift || 1;
409
410 print "checking credentials ";
411
412 if ( !$username ) {
413 fatalerror("no username given");
414 }
415
416 if ( !$password ) {
417 fatalerror("no password given");
418 }
419
420 print "for " . $username . "@" . $DASSCM_SVN_REPOSITORY . ": ";
421
422 # Options for "svn info" are not supported by subversion 1.0.0 (SLES9),
423 # therefore switching to "svn status"
424 # ( my $rc_update, my @result ) =
425 # run_command(
426 # "$SVN info --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
427 # );
428 #print @result;
429
430 my $rc_update;
431 if ($interactive) {
432 $rc_update =
433 run_interactive(
434 "$SVN ls --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
435 );
436 } else {
437 ( $rc_update, my @result ) =
438 run_command(
439 "$SVN ls --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
440 );
441
442 if ( $rc_update != 0 ) {
443 print "\n", @result;
444 if ($fatalerror) {
445 fatalerror();
446 }
447 return;
448 }
449 }
450
451 # return success
452 return $rc_update == 0;
453}
454
455sub svn_update( ;$ )
456{
457 my $update_path = shift || $DASSCM_REPO;
458 ( my $rc_update, my @result ) =
459 run_command(
460 "$SVN update --non-interactive $svnCheckoutCredentials $update_path");
461 print @result;
462 if ( $rc_update != 0 ) {
463 fatalerror();
464 }
465}
466
467sub svn_getStoredFiles( ;$ )
468{
469
470 # TODO: get_filenames?
471 #my $rel_path = shift || "";
472 #my $path = "${DASSCM_REPO}/${rel_path}";
473 my $path = ${DASSCM_REPO};
474
475 # svn ls -R is better, but much, much slower
476 # ( my $rc, my @result ) = run_command("$SVN ls --recursive $svnCheckoutCredentials $path");
477 ( my $rc, my @result ) =
478 run_command(
479 "cd $path && find | grep -v '/.svn' | sed -e 's/\.\\///' | grep -v '^[\.]\$'"
480 );
481 if ( $rc != 0 ) {
482 print @result;
483 fatalerror;
484 }
485 chomp(@result);
486 return @result;
487}
488
489#
490# from an array of files/dirs,
491# generates list of files
492# sorted by type
493#
494sub get_files( @ )
495{
496 my @files = ();
497 my @links = ();
498 my @dirs = ();
499 my @others = ();
500
501 if (@_) {
502 find(
503 {
504 wanted => sub {
505 my $fullname = cwd() . "/" . $_;
506 if ( -l $_ ) {
507
508 # soft link
509 # important: check for links first
510 # to exclude them from further checks
511 push( @links, $fullname );
512 } elsif ( -d $_ ) {
513 push( @dirs, $fullname );
514 } elsif ( -f $_ ) {
515
516 # regular file
517 push( @files, $fullname );
518 } else {
519 push( @others, $fullname );
520 }
521 }
522 },
523 @_
524 );
525 }
526
527 # don't rely on others.
528 # If more specific file types are needed,
529 # they will be added
530 return {
531 files => \@files,
532 links => \@links,
533 dirs => \@dirs,
534 others => \@others
535 };
536}
537
538#####################################################################
539#
540# functions
541
542sub help(;@)
543{
544 if ( @_ == 0 ) {
545 usage();
546 } else {
547 print "help for @_: ...\n";
548 usage();
549 }
550}
551
552sub login(@)
553{
554 check_parameter( @_, 1 );
555 check_env();
556
557 my $input_username = $_[0];
558
559 if ( not $input_username ) {
560 my $output_username = "";
561 if ($DASSCM_USERNAME) {
562 $output_username = " ($DASSCM_USERNAME)";
563 }
564
565 print "Enter DASSCM user name", $output_username, ": ";
566 $input_username = <STDIN>;
567 chomp($input_username);
568
569 $input_username = $input_username || $DASSCM_USERNAME;
570 }
571
572 # hidden password input
573 print "Enter password for $input_username: ";
574 ReadMode('noecho');
575 my $input_password = <STDIN>;
576 ReadMode('normal');
577 chomp($input_password);
578 print "\n";
579
580 # checking checkout username/password
581 svn_check_credentials( $DASSCM_CHECKOUT_USERNAME,
582 $DASSCM_CHECKOUT_PASSWORD );
583 print "checkout access okay\n";
584
585 svn_check_credentials( $input_username, $input_password );
586
587 #
588 # set environment variables
589 #
590 $ENV{'DASSCM_USERNAME'} = $input_username;
591 $ENV{'DASSCM_PASSWORD'} = $input_password;
592
593 print "subversion access okay\n\n", "DASSCM_USERNAME: $input_username\n",
594 "DASSCM_PASSWORD: (hidden)\n", "DASSCM_PROD: $DASSCM_PROD\n",
595 "DASSCM_REPO: $DASSCM_REPO\n",
596 "Server Repository: $DASSCM_SVN_REPOSITORY\n", "\n", "[dasscm shell]\n\n";
597
598 my $shell = $SHELL || "bash";
599 exec($shell) or die "failed to start new shell";
600}
601
602sub init(@)
603{
604 check_parameter( @_, 1 );
605 check_env();
606
607 # don't do repository creation (svn mkdir) here,
608 # because then their must be a lot of prior checks
609
610 # update complete repository
611 # and create permission file
612 my $retcode =
613 run_interactive(
614 "cd $DASSCM_LOCAL_REPOSITORY_BASE; $SVN checkout $svnCheckoutCredentials $svnOptions $DASSCM_SVN_REPOSITORY; mkdir -p `dirname $permissions_file`; touch $permissions_file"
615 );
616}
617
618sub ls(@)
619{
620 check_parameter( @_, 1 );
621 check_env();
622
623 my @files = svn_getStoredFiles(@_);
624
625 print join( "\n", @files );
626 print "\n";
627}
628
629sub update(@)
630{
631 check_parameter( @_, 1 );
632 check_env();
633
634 #
635 # update local repository
636 #
637 svn_update();
638}
639
640#
641# helper function for "add" command
642#
643sub add_helper(@)
644{
645 (
646 my $basename,
647 my $dirname_prod,
648 my $dirname_repo,
649 my $filename_prod,
650 my $filename_repo
651 )
652 = get_filenames( $_[0] );
653
654 if ( $command eq "add" ) {
655 mkpath($dirname_repo);
656 }
657
658 # TODO: are permissions also copied?
659 copy( $filename_prod, $filename_repo )
660 or error "failed to copy $filename_prod to repository: $!";
661
662 if ( $command eq "add" ) {
663
664 # already checked in?
665 chdir $DASSCM_REPO;
666
667 # also add the path to filename.
668 for my $dir ( split( '/', $dirname_prod ) ) {
669 if ($dir) {
670 my ( $rc, @out ) =
671 run_command( "$SVN add --non-recursive \"" . $dir . "\"" );
672 if ( $rc > 0 ) {
673 print join( "\n", @out );
674 }
675 chdir $dir;
676 }
677 }
678 my ( $rc, @out ) = run_command( "$SVN add \"" . $basename . "\"" );
679 if ( $rc > 0 ) {
680 print join( "\n", @out );
681 }
682 chdir $StartDirectory;
683 }
684}
685
686#
687# add (is used for command add and commit)
688#
689sub add(@)
690{
691 check_parameter( @_, 1 );
692 check_env();
693
694 #
695 # update local repository
696 #
697 svn_update();
698
699 # get all regular files and links
700 my $href_files = get_files(@_);
701
702 #print Dumper( $href_files );
703
704 my @files = @{ $href_files->{files} };
705 my @links = @{ $href_files->{links} };
706
707 if (@files) {
708 my $number = $#files + 1;
709 print "files to check-in ($number): \n";
710 print join( "\n", @files );
711 print "\n";
712 }
713
714 if (@links) {
715 my $number = $#links + 1;
716 print "\n";
717 print "ignoring links ($number):\n";
718 print join( "\n", @links );
719 print "\n";
720 }
721
722 # TODO: confirm
723
724 # copy files one by one to local repository
725 for my $file (@files) {
726
727 # add file
728 add_helper($file);
729 }
730
731 # create new permissions file
732 permissions();
733
734 # add permissions file
735 add_helper($permissions_file);
736
737 if ( $options{'message'} ) {
738 $svnOptions .= " --message \"$options{'message'}\" ";
739 }
740
741 # commit calls $EDITOR.
742 # use "interactive" here, to display output
743 my $retcode =
744 run_interactive(
745 "$SVN commit $svnOptions --username $DASSCM_USERNAME $svnPasswordCredentials $DASSCM_REPO"
746 );
747
748 #print $filename_prod. "\n";
749 #print $dirname_repo. "\n";
750}
751
752sub blame(@)
753{
754 check_parameter( @_, 1 );
755 check_env();
756
757 (
758 my $basename,
759 my $dirname_prod,
760 my $dirname_repo,
761 my $filename_prod,
762 my $filename_repo
763 )
764 = get_filenames( $_[0] );
765
766 my $retcode = run_interactive("$SVN blame $svnOptions $filename_repo");
767}
768
769sub diff(@)
770{
771 check_parameter( @_, 1 );
772 check_env();
773
774 (
775 my $basename,
776 my $dirname_prod,
777 my $dirname_repo,
778 my $filename_prod,
779 my $filename_repo
780 )
781 = get_filenames( $_[0] );
782
783 #print "$basename,$dirname_prod,$dirname_repo\n";
784
785 ( my $rc_update, my @result ) = run_command("$SVN update $filename_repo");
786 if ( $rc_update != 0 ) {
787 print @result;
788 die;
789 }
790
791 ( my $rc_diff, my @diff_result ) =
792 run_command( $diff . " $filename_repo $filename_prod" );
793
794 print @diff_result;
795}
796
797sub status(@)
798{
799 check_parameter( @_, 1 );
800 check_env();
801
802 # return code for the shell
803 # default: error
804 my $return_code = $RETURN_NOK;
805
806 #
807 # update local repository
808 #
809 svn_update();
810
811 # TODO: start at subdirectories ?
812 my $dir = $DASSCM_REPO;
813 my @files = svn_getStoredFiles($dir);
814
815 # Liste der geänderten Files ausgeben, falls nicht leer
816 if (@files) {
817
818 # stores result from status (cvscheck)
819 my %removedfiles = ();
820 my %changedfiles = ();
821
822 foreach my $file (@files) {
823
824 my $realfile = "/" . $file;
825 my $cvsworkfile = "${DASSCM_REPO}/${file}";
826
827 if ( -d $realfile ) {
828
829 # directory. do nothing
830 } elsif ( !-r $realfile ) {
831 $removedfiles{"$realfile"} = $cvsworkfile;
832 } else {
833 ( -r "$cvsworkfile" )
834 || die("Fehler: $cvsworkfile ist nicht lesbar");
835 if ( compare( $cvsworkfile, $realfile ) != 0 ) {
836 $changedfiles{"$realfile"} = $cvsworkfile;
837 }
838 }
839 }
840
841 if (%removedfiles) {
842 print "deleted files (found in repository, but not in system):\n";
843 foreach my $key ( values %removedfiles ) {
844 print "$key\n";
845 }
846 print "\n";
847 }
848
849 if (%changedfiles) {
850 print "modified files:\n";
851 foreach my $key ( keys %changedfiles ) {
852 print "$key\n";
853 }
854 }
855 } else {
856 print "no modified files found in $dir\n";
857 $return_code = $RETURN_OK;
858 }
859
860 print "\n";
861
862 return $return_code;
863}
864
865sub permissions(@)
866{
867 check_parameter( @_, 1 );
868 check_env();
869
870 #
871 # update local repository
872 #
873 #svn_update();
874
875 # TODO: start at subdirectories ?
876 my $dir = $DASSCM_REPO;
877 my @files = svn_getStoredFiles($dir);
878
879 if (@files) {
880
881 # generieren der Permissions
882 my @permissions = generatePermissionList(@files);
883 my $OUTFILE;
884 my $tofile = 0; # Status für schreiben in File
885
886 if ( -w dirname($permissions_file) ) {
887
888 # Verzeichnis existiert => schreiben
889 print "storing permissions in file $permissions_file\n";
890 open( OUTFILE, ">$permissions_file" )
891 || die("failed to write to $permissions_file: $!");
892 $tofile = 1; # Merken, daß in File geschrieben wird
893 print OUTFILE "#\n";
894 print OUTFILE "# created by dasscm permissions\n";
895 print OUTFILE
896 "# It is intended to be used for restoring permissions\n";
897 } else {
898
899 # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
900 # Alias Filehandle für stdout erzeugen
901 *OUTFILE = *STDOUT;
902 }
903 foreach my $line (@permissions) {
904 print OUTFILE "$line\n";
905 }
906
907 if ($tofile) {
908 close(OUTFILE);
909 }
910 }
911}
912
913#####################################################################
914#
915# main
916#
917
918my $return_code = $RETURN_OK;
919my $number_arguments = @ARGV;
920
921if ( $number_arguments > 0 ) {
922
923 # get subcommand and remove it from @ARGV
924 $command = $ARGV[0];
925 shift @ARGV;
926
927 $DASSCM_LOCAL_REPOSITORY_BASE = $config->{'DASSCM_LOCAL_REPOSITORY_BASE'};
928 $DASSCM_REPOSITORY_NAME = $config->{'DASSCM_REPOSITORY_NAME'};
929
930 # TODO: check variables
931 $DASSCM_SVN_REPOSITORY =
932 $config->{'DASSCM_SVN_REPOSITORY_BASE'} . "/" . $DASSCM_REPOSITORY_NAME;
933
934 $DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
935 $DASSCM_CHECKOUT_PASSWORD = $config->{'DASSCM_CHECKOUT_PASSWORD'};
936
937 #
938 # if a user is given by dasscm configuration file, we use it.
939 # Otherwise we expect that read-only account is configured
940 # as local subversion configuration.
941 # If this is also not the case,
942 # user is required to type username and password.
943 # This will be stored as local subversion configuration thereafter.
944 #
945 if ( $DASSCM_CHECKOUT_USERNAME && $DASSCM_CHECKOUT_PASSWORD ) {
946 $svnCheckoutCredentials =
947 " --username $DASSCM_CHECKOUT_USERNAME --password $DASSCM_CHECKOUT_PASSWORD ";
948 }
949
950 # get command line options and store them in options hash
951 my $result = GetOptions( \%options, 'verbose', 'message=s' );
952
953 # print options
954 foreach my $option ( keys %options ) {
955 print "${option}: $options{$option}\n";
956 }
957
958 # set verbose to command line option
959 $verbose = $options{'verbose'};
960
961 #
962 # action accordinly to command are taken
963 # $command is rewritten in standard format,
964 # so we can test for it later on more simply
965 #
966 $_ = $command;
967 if (m/help/i) {
968 help(@ARGV);
969 } elsif (m/login/i) {
970 $command = "login";
971 login(@ARGV);
972 } elsif (m/init/i) {
973 $command = "init";
974 init(@ARGV);
975 } elsif (m/ls/i) {
976 $command = "ls";
977 ls(@ARGV);
978 } elsif ( (m/update/i) || (m/up/i) ) {
979 $command = "update";
980 update(@ARGV);
981 } elsif (m/add/i) {
982 $command = "add";
983 add(@ARGV);
984 } elsif ( (m/commit/i) || (m/ci/i) ) {
985 $command = "commit";
986 add(@ARGV);
987 } elsif (m/blame/i) {
988 $command = "blame";
989 blame(@ARGV);
990 } elsif (m/diff/i) {
991 $command = "diff";
992 diff(@ARGV);
993 } elsif ( (m/status/i) || (m/st/i) ) {
994 $command = "status";
995 $return_code = status(@ARGV);
996 } elsif (m/permissions/i) {
997 $command = "permissions";
998 permissions(@ARGV);
999 } else {
1000 print "unknown command: $command\n\n";
1001 usage();
1002 check_env();
1003 $return_code = $RETURN_NOK;
1004 }
1005
1006 # cleanup (svn-commit.tmp)
1007 # commitall
1008 # revert
1009 # activate
1010 # rm
1011
1012}
1013
1014exit $return_code;
Note: See TracBrowser for help on using the repository browser.