source: trunk/dasscm/dasscm@ 260

Last change on this file since 260 was 260, checked in by joergs, on Dec 23, 2008 at 1:12:54 PM

added comment

  • Property keyword set to id
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 25.2 KB
Line 
1#!/usr/bin/perl -w
2
3# $Id: dasscm 260 2008-12-23 12:12:54Z 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
602
603#
604# initialize local checkout directory (initial checkout)
605#
606sub init(@)
607{
608 check_parameter( @_, 1 );
609 check_env();
610
611 # don't do repository creation (svn mkdir) here,
612 # because then their must be a lot of prior checks
613
614 # update complete repository
615 # and create permission file
616 my $retcode =
617 run_interactive(
618 "cd $DASSCM_LOCAL_REPOSITORY_BASE; $SVN checkout $svnCheckoutCredentials $svnOptions $DASSCM_SVN_REPOSITORY; mkdir -p `dirname $permissions_file`; touch $permissions_file"
619 );
620}
621
622
623
624sub ls(@)
625{
626 check_parameter( @_, 1 );
627 check_env();
628
629 my @files = svn_getStoredFiles(@_);
630
631 print join( "\n", @files );
632 print "\n";
633}
634
635sub update(@)
636{
637 check_parameter( @_, 1 );
638 check_env();
639
640 #
641 # update local repository
642 #
643 svn_update();
644}
645
646#
647# helper function for "add" command
648#
649sub add_helper(@)
650{
651 (
652 my $basename,
653 my $dirname_prod,
654 my $dirname_repo,
655 my $filename_prod,
656 my $filename_repo
657 )
658 = get_filenames( $_[0] );
659
660 if ( $command eq "add" ) {
661 mkpath($dirname_repo);
662 }
663
664 # TODO: are permissions also copied?
665 copy( $filename_prod, $filename_repo )
666 or error "failed to copy $filename_prod to repository: $!";
667
668 if ( $command eq "add" ) {
669
670 # already checked in?
671 chdir $DASSCM_REPO;
672
673 # also add the path to filename.
674 for my $dir ( split( '/', $dirname_prod ) ) {
675 if ($dir) {
676 my ( $rc, @out ) =
677 run_command( "$SVN add --non-recursive \"" . $dir . "\"" );
678 if ( $rc > 0 ) {
679 print join( "\n", @out );
680 }
681 chdir $dir;
682 }
683 }
684 my ( $rc, @out ) = run_command( "$SVN add \"" . $basename . "\"" );
685 if ( $rc > 0 ) {
686 print join( "\n", @out );
687 }
688 chdir $StartDirectory;
689 }
690}
691
692#
693# add (is used for command add and commit)
694#
695sub add(@)
696{
697 check_parameter( @_, 1 );
698 check_env();
699
700 #
701 # update local repository
702 #
703 svn_update();
704
705 # get all regular files and links
706 my $href_files = get_files(@_);
707
708 #print Dumper( $href_files );
709
710 my @files = @{ $href_files->{files} };
711 my @links = @{ $href_files->{links} };
712
713 if (@files) {
714 my $number = $#files + 1;
715 print "files to check-in ($number): \n";
716 print join( "\n", @files );
717 print "\n";
718 }
719
720 if (@links) {
721 my $number = $#links + 1;
722 print "\n";
723 print "ignoring links ($number):\n";
724 print join( "\n", @links );
725 print "\n";
726 }
727
728 # TODO: confirm
729
730 # copy files one by one to local repository
731 for my $file (@files) {
732
733 # add file
734 add_helper($file);
735 }
736
737 # create new permissions file
738 permissions();
739
740 # add permissions file
741 add_helper($permissions_file);
742
743 if ( $options{'message'} ) {
744 $svnOptions .= " --message \"$options{'message'}\" ";
745 }
746
747 # commit calls $EDITOR.
748 # use "interactive" here, to display output
749 my $retcode =
750 run_interactive(
751 "$SVN commit $svnOptions --username $DASSCM_USERNAME $svnPasswordCredentials $DASSCM_REPO"
752 );
753
754 #print $filename_prod. "\n";
755 #print $dirname_repo. "\n";
756}
757
758sub blame(@)
759{
760 check_parameter( @_, 1 );
761 check_env();
762
763 (
764 my $basename,
765 my $dirname_prod,
766 my $dirname_repo,
767 my $filename_prod,
768 my $filename_repo
769 )
770 = get_filenames( $_[0] );
771
772 my $retcode = run_interactive("$SVN blame $svnOptions $filename_repo");
773}
774
775sub diff(@)
776{
777 check_parameter( @_, 1 );
778 check_env();
779
780 (
781 my $basename,
782 my $dirname_prod,
783 my $dirname_repo,
784 my $filename_prod,
785 my $filename_repo
786 )
787 = get_filenames( $_[0] );
788
789 #print "$basename,$dirname_prod,$dirname_repo\n";
790
791 ( my $rc_update, my @result ) = run_command("$SVN update $filename_repo");
792 if ( $rc_update != 0 ) {
793 print @result;
794 die;
795 }
796
797 ( my $rc_diff, my @diff_result ) =
798 run_command( $diff . " $filename_repo $filename_prod" );
799
800 print @diff_result;
801}
802
803sub status(@)
804{
805 check_parameter( @_, 1 );
806 check_env();
807
808 # return code for the shell
809 # default: error
810 my $return_code = $RETURN_NOK;
811
812 #
813 # update local repository
814 #
815 svn_update();
816
817 # TODO: start at subdirectories ?
818 my $dir = $DASSCM_REPO;
819 my @files = svn_getStoredFiles($dir);
820
821 # Liste der geänderten Files ausgeben, falls nicht leer
822 if (@files) {
823
824 # stores result from status (cvscheck)
825 my %removedfiles = ();
826 my %changedfiles = ();
827
828 foreach my $file (@files) {
829
830 my $realfile = "/" . $file;
831 my $cvsworkfile = "${DASSCM_REPO}/${file}";
832
833 if ( -d $realfile ) {
834
835 # directory. do nothing
836 } elsif ( !-r $realfile ) {
837 $removedfiles{"$realfile"} = $cvsworkfile;
838 } else {
839 ( -r "$cvsworkfile" )
840 || die("Fehler: $cvsworkfile ist nicht lesbar");
841 if ( compare( $cvsworkfile, $realfile ) != 0 ) {
842 $changedfiles{"$realfile"} = $cvsworkfile;
843 }
844 }
845 }
846
847 if (%removedfiles) {
848 print "deleted files (found in repository, but not in system):\n";
849 foreach my $key ( values %removedfiles ) {
850 print "$key\n";
851 }
852 print "\n";
853 }
854
855 if (%changedfiles) {
856 print "modified files:\n";
857 foreach my $key ( keys %changedfiles ) {
858 print "$key\n";
859 }
860 }
861 } else {
862 print "no modified files found in $dir\n";
863 $return_code = $RETURN_OK;
864 }
865
866 print "\n";
867
868 return $return_code;
869}
870
871sub permissions(@)
872{
873 check_parameter( @_, 1 );
874 check_env();
875
876 #
877 # update local repository
878 #
879 #svn_update();
880
881 # TODO: start at subdirectories ?
882 my $dir = $DASSCM_REPO;
883 my @files = svn_getStoredFiles($dir);
884
885 if (@files) {
886
887 # generieren der Permissions
888 my @permissions = generatePermissionList(@files);
889 my $OUTFILE;
890 my $tofile = 0; # Status für schreiben in File
891
892 if ( -w dirname($permissions_file) ) {
893
894 # Verzeichnis existiert => schreiben
895 print "storing permissions in file $permissions_file\n";
896 open( OUTFILE, ">$permissions_file" )
897 || die("failed to write to $permissions_file: $!");
898 $tofile = 1; # Merken, daß in File geschrieben wird
899 print OUTFILE "#\n";
900 print OUTFILE "# created by dasscm permissions\n";
901 print OUTFILE
902 "# It is intended to be used for restoring permissions\n";
903 } else {
904
905 # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
906 # Alias Filehandle für stdout erzeugen
907 *OUTFILE = *STDOUT;
908 }
909 foreach my $line (@permissions) {
910 print OUTFILE "$line\n";
911 }
912
913 if ($tofile) {
914 close(OUTFILE);
915 }
916 }
917}
918
919#####################################################################
920#
921# main
922#
923
924my $return_code = $RETURN_OK;
925my $number_arguments = @ARGV;
926
927if ( $number_arguments > 0 ) {
928
929 # get subcommand and remove it from @ARGV
930 $command = $ARGV[0];
931 shift @ARGV;
932
933 $DASSCM_LOCAL_REPOSITORY_BASE = $config->{'DASSCM_LOCAL_REPOSITORY_BASE'};
934 $DASSCM_REPOSITORY_NAME = $config->{'DASSCM_REPOSITORY_NAME'};
935
936 # TODO: check variables
937 $DASSCM_SVN_REPOSITORY =
938 $config->{'DASSCM_SVN_REPOSITORY_BASE'} . "/" . $DASSCM_REPOSITORY_NAME;
939
940 $DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
941 $DASSCM_CHECKOUT_PASSWORD = $config->{'DASSCM_CHECKOUT_PASSWORD'};
942
943 #
944 # if a user is given by dasscm configuration file, we use it.
945 # Otherwise we expect that read-only account is configured
946 # as local subversion configuration.
947 # If this is also not the case,
948 # user is required to type username and password.
949 # This will be stored as local subversion configuration thereafter.
950 #
951 if ( $DASSCM_CHECKOUT_USERNAME && $DASSCM_CHECKOUT_PASSWORD ) {
952 $svnCheckoutCredentials =
953 " --username $DASSCM_CHECKOUT_USERNAME --password $DASSCM_CHECKOUT_PASSWORD ";
954 }
955
956 # get command line options and store them in options hash
957 my $result = GetOptions( \%options, 'verbose', 'message=s' );
958
959 # print options
960 foreach my $option ( keys %options ) {
961 print "${option}: $options{$option}\n";
962 }
963
964 # set verbose to command line option
965 $verbose = $options{'verbose'};
966
967 #
968 # action accordinly to command are taken
969 # $command is rewritten in standard format,
970 # so we can test for it later on more simply
971 #
972 $_ = $command;
973 if (m/help/i) {
974 help(@ARGV);
975 } elsif (m/login/i) {
976 $command = "login";
977 login(@ARGV);
978 } elsif (m/init/i) {
979 $command = "init";
980 init(@ARGV);
981 } elsif (m/ls/i) {
982 $command = "ls";
983 ls(@ARGV);
984 } elsif ( (m/update/i) || (m/up/i) ) {
985 $command = "update";
986 update(@ARGV);
987 } elsif (m/add/i) {
988 $command = "add";
989 add(@ARGV);
990 } elsif ( (m/commit/i) || (m/ci/i) ) {
991 $command = "commit";
992 add(@ARGV);
993 } elsif (m/blame/i) {
994 $command = "blame";
995 blame(@ARGV);
996 } elsif (m/diff/i) {
997 $command = "diff";
998 diff(@ARGV);
999 } elsif ( (m/status/i) || (m/st/i) ) {
1000 $command = "status";
1001 $return_code = status(@ARGV);
1002 } elsif (m/permissions/i) {
1003 $command = "permissions";
1004 permissions(@ARGV);
1005 } else {
1006 print "unknown command: $command\n\n";
1007 usage();
1008 check_env();
1009 $return_code = $RETURN_NOK;
1010 }
1011
1012 # cleanup (svn-commit.tmp)
1013 # commitall
1014 # revert
1015 # activate
1016 # rm
1017
1018}
1019
1020exit $return_code;
Note: See TracBrowser for help on using the repository browser.