source: trunk/dasscm/dasscm@ 252

Last change on this file since 252 was 252, checked in by joergs, on Dec 22, 2008 at 6:10:02 PM

added return code, don't require login so often, init creates missing directories, perltidy

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