source: trunk/dasscm/dasscm@ 253

Last change on this file since 253 was 253, checked in by joergs, on Dec 22, 2008 at 6:12:17 PM

added comments

  • 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 253 2008-12-22 17:12:17Z 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
304sub generatePermissionList
305{
306
307 # generieren der Zeilen für Permission-Savefile
308 my @files = @_;
309 my @permlist = ();
310 foreach my $file (@files) {
311 $file = "/" . $file;
312 if ( -e $file ) {
313 my $info = stat($file) || die "failed to stat $file: aborting";
314 my $mode = get_type( $info->mode ) & 07777;
315 my $modestring = sprintf( "%04o", $mode );
316 my $uid = $info->uid;
317 my $uidname = getpwuid($uid);
318 my $gid = $info->gid;
319 my $gidname = getgrgid($gid);
320 push(
321 @permlist,
322 sprintf( "%-55s %-17s %4d",
323 $file, "${uidname}:${gidname}", $modestring )
324 );
325 } else {
326 print
327 "failed to get status of $file. It exists in the repository, but not on the system\n";
328 }
329 }
330 return @permlist;
331}
332
333sub get_type
334{
335
336 # Funktion übernommen aus /usr/bin/chkstat
337 my $S_IFLNK = 0120000; # symbolic link
338 my $S_IFREG = 0100000; # regular file
339 my $S_IFDIR = 0040000; # directory
340 my $S_IFCHAR = 0020000; # character device
341 my $S_IFBLK = 0060000; # block device
342 my $S_IFFIFO = 0010000; # fifo
343 my $S_IFSOCK = 0140000; # socket
344 my $S_IFMT = 0170000; # type of file
345
346 my $S_m;
347 if ( ( $_[0] & $S_IFMT ) == $S_IFLNK ) { $S_m = $_[0] - $S_IFLNK; }
348 elsif ( ( $_[0] & $S_IFMT ) == $S_IFREG ) { $S_m = $_[0] - $S_IFREG; }
349 elsif ( ( $_[0] & $S_IFMT ) == $S_IFDIR ) { $S_m = $_[0] - $S_IFDIR; }
350 elsif ( ( $_[0] & $S_IFMT ) == $S_IFCHAR ) { $S_m = $_[0] - $S_IFCHAR; }
351 elsif ( ( $_[0] & $S_IFMT ) == $S_IFBLK ) { $S_m = $_[0] - $S_IFBLK; }
352 elsif ( ( $_[0] & $S_IFMT ) == $S_IFFIFO ) { $S_m = $_[0] - $S_IFFIFO; }
353 elsif ( ( $_[0] & $S_IFMT ) == $S_IFSOCK ) { $S_m = $_[0] - $S_IFSOCK; }
354 $S_m;
355}
356
357sub run_command
358{
359 my $command = shift;
360
361 #print "executing command: " . $command . "\n";
362
363 open( RESULT, $command . ' 2>&1 |' );
364 my @result = <RESULT>;
365 close(RESULT);
366 my $retcode = $? >> 8;
367
368 #print @result;
369 #if( $retcode ) { print "return code: " . $retcode . "\n"; }
370
371 return ( $retcode, @result );
372}
373
374sub run_interactive
375{
376
377 if ($verbose) {
378 print "run_interactive:" . join( " ", @_ ) . "\n";
379 }
380
381 system(@_);
382 if ( $? == -1 ) {
383 printf "failed to execute: $!\n";
384 } elsif ( $? & 127 ) {
385 printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
386 ( $? & 128 ) ? 'with' : 'without';
387 } elsif ( $? >> 8 != 0 ) {
388 printf "child exited with value %d\n", $? >> 8;
389 }
390 return ( $? >> 8 );
391}
392
393sub svn_check_credentials( $$;$$ )
394{
395 my $username = shift;
396 my $password = shift;
397
398 # check silently are allow user interaction?
399 my $interactive = shift || 0;
400
401 # default: exit program, if repository is not accessable
402 # (do not exit for 'init')
403 my $fatalerror = shift || 1;
404
405 print "checking credentials ";
406
407 if ( !$username ) {
408 fatalerror("no username given");
409 }
410
411 if ( !$password ) {
412 fatalerror("no password given");
413 }
414
415 print "for " . $username . "@" . $DASSCM_SVN_REPOSITORY . ": ";
416
417 # Options for "svn info" are not supported by subversion 1.0.0 (SLES9),
418 # therefore switching to "svn status"
419 # ( my $rc_update, my @result ) =
420 # run_command(
421 # "$SVN info --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
422 # );
423 #print @result;
424
425 my $rc_update;
426 if ($interactive) {
427 $rc_update =
428 run_interactive(
429 "$SVN ls --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
430 );
431 } else {
432 ( $rc_update, my @result ) =
433 run_command(
434 "$SVN ls --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
435 );
436
437 if ( $rc_update != 0 ) {
438 print "\n", @result;
439 if ($fatalerror) {
440 fatalerror();
441 }
442 return;
443 }
444 }
445
446 # return success
447 return $rc_update == 0;
448}
449
450sub svn_update( ;$ )
451{
452 my $update_path = shift || $DASSCM_REPO;
453 ( my $rc_update, my @result ) =
454 run_command(
455 "$SVN update --non-interactive $svnCheckoutCredentials $update_path");
456 print @result;
457 if ( $rc_update != 0 ) {
458 fatalerror();
459 }
460}
461
462sub svn_getStoredFiles( ;$ )
463{
464
465 # TODO: get_filenames?
466 #my $rel_path = shift || "";
467 #my $path = "${DASSCM_REPO}/${rel_path}";
468 my $path = ${DASSCM_REPO};
469
470 # svn ls -R is better, but much, much slower
471 # ( my $rc, my @result ) = run_command("$SVN ls --recursive $svnCheckoutCredentials $path");
472 ( my $rc, my @result ) =
473 run_command(
474 "cd $path && find | grep -v '/.svn' | sed -e 's/\.\\///' | grep -v '^[\.]\$'"
475 );
476 if ( $rc != 0 ) {
477 print @result;
478 fatalerror;
479 }
480 chomp(@result);
481 return @result;
482}
483
484#
485# from an array of files/dirs,
486# generates list of files
487# sorted by type
488#
489sub get_files( @ )
490{
491 my @files = ();
492 my @links = ();
493 my @dirs = ();
494 my @others = ();
495
496 if (@_) {
497 find(
498 {
499 wanted => sub {
500 my $fullname = cwd() . "/" . $_;
501 if ( -l $_ ) {
502
503 # soft link
504 # important: check for links first
505 # to exclude them from further checks
506 push( @links, $fullname );
507 } elsif ( -d $_ ) {
508 push( @dirs, $fullname );
509 } elsif ( -f $_ ) {
510
511 # regular file
512 push( @files, $fullname );
513 } else {
514 push( @others, $fullname );
515 }
516 }
517 },
518 @_
519 );
520 }
521
522 # don't rely on others.
523 # If more specific file types are needed,
524 # they will be added
525 return {
526 files => \@files,
527 links => \@links,
528 dirs => \@dirs,
529 others => \@others
530 };
531}
532
533#####################################################################
534#
535# functions
536
537sub help(;@)
538{
539 if ( @_ == 0 ) {
540 usage();
541 } else {
542 print "help for @_: ...\n";
543 usage();
544 }
545}
546
547sub login(@)
548{
549 check_parameter( @_, 1 );
550 check_env();
551
552 my $input_username = $_[0];
553
554 if ( not $input_username ) {
555 my $output_username = "";
556 if ($DASSCM_USERNAME) {
557 $output_username = " ($DASSCM_USERNAME)";
558 }
559
560 print "Enter DASSCM user name", $output_username, ": ";
561 $input_username = <STDIN>;
562 chomp($input_username);
563
564 $input_username = $input_username || $DASSCM_USERNAME;
565 }
566
567 # hidden password input
568 print "Enter password for $input_username: ";
569 ReadMode('noecho');
570 my $input_password = <STDIN>;
571 ReadMode('normal');
572 chomp($input_password);
573 print "\n";
574
575 # checking checkout username/password
576 svn_check_credentials( $DASSCM_CHECKOUT_USERNAME,
577 $DASSCM_CHECKOUT_PASSWORD );
578 print "checkout access okay\n";
579
580 svn_check_credentials( $input_username, $input_password );
581
582 #
583 # set environment variables
584 #
585 $ENV{'DASSCM_USERNAME'} = $input_username;
586 $ENV{'DASSCM_PASSWORD'} = $input_password;
587
588 print "subversion access okay\n\n", "DASSCM_USERNAME: $input_username\n",
589 "DASSCM_PASSWORD: (hidden)\n", "DASSCM_PROD: $DASSCM_PROD\n",
590 "DASSCM_REPO: $DASSCM_REPO\n",
591 "Server Repository: $DASSCM_SVN_REPOSITORY\n", "\n", "[dasscm shell]\n\n";
592
593 my $shell = $SHELL || "bash";
594 exec($shell) or die "failed to start new shell";
595}
596
597sub init(@)
598{
599 check_parameter( @_, 1 );
600 check_env();
601
602 # don't do repository creation (svn mkdir) here,
603 # because then their must be a lot of prior checks
604
605 # update complete repository
606 # and create permission file
607 my $retcode =
608 run_interactive(
609 "cd $DASSCM_LOCAL_REPOSITORY_BASE; $SVN checkout $svnCheckoutCredentials $svnOptions $DASSCM_SVN_REPOSITORY; mkdir -p `dirname $permissions_file`; touch $permissions_file"
610 );
611}
612
613sub ls(@)
614{
615 check_parameter( @_, 1 );
616 check_env();
617
618 my @files = svn_getStoredFiles(@_);
619
620 print join( "\n", @files );
621 print "\n";
622}
623
624sub update(@)
625{
626 check_parameter( @_, 1 );
627 check_env();
628
629 #
630 # update local repository
631 #
632 svn_update();
633}
634
635#
636# helper function for "add" command
637#
638sub add_helper(@)
639{
640 (
641 my $basename,
642 my $dirname_prod,
643 my $dirname_repo,
644 my $filename_prod,
645 my $filename_repo
646 )
647 = get_filenames( $_[0] );
648
649 if ( $command eq "add" ) {
650 mkpath($dirname_repo);
651 }
652
653 # TODO: are permissions also copied?
654 copy( $filename_prod, $filename_repo )
655 or error "failed to copy $filename_prod to repository: $!";
656
657 if ( $command eq "add" ) {
658
659 # already checked in?
660 chdir $DASSCM_REPO;
661
662 # also add the path to filename.
663 for my $dir ( split( '/', $dirname_prod ) ) {
664 if ($dir) {
665 my ( $rc, @out ) =
666 run_command( "$SVN add --non-recursive \"" . $dir . "\"" );
667 if ( $rc > 0 ) {
668 print join( "\n", @out );
669 }
670 chdir $dir;
671 }
672 }
673 my ( $rc, @out ) = run_command( "$SVN add \"" . $basename . "\"" );
674 if ( $rc > 0 ) {
675 print join( "\n", @out );
676 }
677 chdir $StartDirectory;
678 }
679}
680
681#
682# add (is used for command add and commit)
683#
684sub add(@)
685{
686 check_parameter( @_, 1 );
687 check_env();
688
689 #
690 # update local repository
691 #
692 svn_update();
693
694 # get all regular files and links
695 my $href_files = get_files(@_);
696
697 #print Dumper( $href_files );
698
699 my @files = @{ $href_files->{files} };
700 my @links = @{ $href_files->{links} };
701
702 if (@files) {
703 my $number = $#files + 1;
704 print "files to check-in ($number): \n";
705 print join( "\n", @files );
706 print "\n";
707 }
708
709 if (@links) {
710 my $number = $#links + 1;
711 print "\n";
712 print "ignoring links ($number):\n";
713 print join( "\n", @links );
714 print "\n";
715 }
716
717 # TODO: confirm
718
719 # copy files one by one to local repository
720 for my $file (@files) {
721
722 # add file
723 add_helper($file);
724 }
725
726 # create new permissions file
727 permissions();
728
729 # add permissions file
730 add_helper($permissions_file);
731
732 if ( $options{'message'} ) {
733 $svnOptions .= " --message \"$options{'message'}\" ";
734 }
735
736 # commit calls $EDITOR.
737 # use "interactive" here, to display output
738 my $retcode =
739 run_interactive(
740 "$SVN commit $svnOptions --username $DASSCM_USERNAME $svnPasswordCredentials $DASSCM_REPO"
741 );
742
743 #print $filename_prod. "\n";
744 #print $dirname_repo. "\n";
745}
746
747sub blame(@)
748{
749 check_parameter( @_, 1 );
750 check_env();
751
752 (
753 my $basename,
754 my $dirname_prod,
755 my $dirname_repo,
756 my $filename_prod,
757 my $filename_repo
758 )
759 = get_filenames( $_[0] );
760
761 my $retcode = run_interactive("$SVN blame $svnOptions $filename_repo");
762}
763
764sub diff(@)
765{
766 check_parameter( @_, 1 );
767 check_env();
768
769 (
770 my $basename,
771 my $dirname_prod,
772 my $dirname_repo,
773 my $filename_prod,
774 my $filename_repo
775 )
776 = get_filenames( $_[0] );
777
778 #print "$basename,$dirname_prod,$dirname_repo\n";
779
780 ( my $rc_update, my @result ) = run_command("$SVN update $filename_repo");
781 if ( $rc_update != 0 ) {
782 print @result;
783 die;
784 }
785
786 ( my $rc_diff, my @diff_result ) =
787 run_command( $diff . " $filename_repo $filename_prod" );
788
789 print @diff_result;
790}
791
792sub status(@)
793{
794 check_parameter( @_, 1 );
795 check_env();
796
797 # return code for the shell
798 # default: error
799 my $return_code = $RETURN_NOK;
800
801 #
802 # update local repository
803 #
804 svn_update();
805
806 # TODO: start at subdirectories ?
807 my $dir = $DASSCM_REPO;
808 my @files = svn_getStoredFiles($dir);
809
810 # Liste der geänderten Files ausgeben, falls nicht leer
811 if (@files) {
812
813 # stores result from status (cvscheck)
814 my %removedfiles = ();
815 my %changedfiles = ();
816
817 foreach my $file (@files) {
818
819 my $realfile = "/" . $file;
820 my $cvsworkfile = "${DASSCM_REPO}/${file}";
821
822 if ( -d $realfile ) {
823
824 # directory. do nothing
825 } elsif ( !-r $realfile ) {
826 $removedfiles{"$realfile"} = $cvsworkfile;
827 } else {
828 ( -r "$cvsworkfile" )
829 || die("Fehler: $cvsworkfile ist nicht lesbar");
830 if ( compare( $cvsworkfile, $realfile ) != 0 ) {
831 $changedfiles{"$realfile"} = $cvsworkfile;
832 }
833 }
834 }
835
836 if (%removedfiles) {
837 print "deleted files (found in repository, but not in system):\n";
838 foreach my $key ( values %removedfiles ) {
839 print "$key\n";
840 }
841 print "\n";
842 }
843
844 if (%changedfiles) {
845 print "modified files:\n";
846 foreach my $key ( keys %changedfiles ) {
847 print "$key\n";
848 }
849 }
850 } else {
851 print "no modified files found in $dir\n";
852 $return_code = $RETURN_OK;
853 }
854
855 print "\n";
856
857 return $return_code;
858}
859
860sub permissions(@)
861{
862 check_parameter( @_, 1 );
863 check_env();
864
865 #
866 # update local repository
867 #
868 #svn_update();
869
870 # TODO: start at subdirectories ?
871 my $dir = $DASSCM_REPO;
872 my @files = svn_getStoredFiles($dir);
873
874 if (@files) {
875
876 # generieren der Permissions
877 my @permissions = generatePermissionList(@files);
878 my $OUTFILE;
879 my $tofile = 0; # Status für schreiben in File
880
881 if ( -w dirname($permissions_file) ) {
882
883 # Verzeichnis existiert => schreiben
884 print "storing permissions in file $permissions_file\n";
885 open( OUTFILE, ">$permissions_file" )
886 || die("failed to write to $permissions_file: $!");
887 $tofile = 1; # Merken, daß in File geschrieben wird
888 print OUTFILE "#\n";
889 print OUTFILE "# created by dasscm permissions\n";
890 print OUTFILE
891 "# It is intended to be used for restoring permissions\n";
892 } else {
893
894 # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
895 # Alias Filehandle für stdout erzeugen
896 *OUTFILE = *STDOUT;
897 }
898 foreach my $line (@permissions) {
899 print OUTFILE "$line\n";
900 }
901
902 if ($tofile) {
903 close(OUTFILE);
904 }
905 }
906}
907
908#####################################################################
909#
910# main
911#
912
913my $return_code = $RETURN_OK;
914my $number_arguments = @ARGV;
915
916if ( $number_arguments > 0 ) {
917
918 # get subcommand and remove it from @ARGV
919 $command = $ARGV[0];
920 shift @ARGV;
921
922 $DASSCM_LOCAL_REPOSITORY_BASE = $config->{'DASSCM_LOCAL_REPOSITORY_BASE'};
923 $DASSCM_REPOSITORY_NAME = $config->{'DASSCM_REPOSITORY_NAME'};
924
925 # TODO: check variables
926 $DASSCM_SVN_REPOSITORY =
927 $config->{'DASSCM_SVN_REPOSITORY_BASE'} . "/" . $DASSCM_REPOSITORY_NAME;
928
929 $DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
930 $DASSCM_CHECKOUT_PASSWORD = $config->{'DASSCM_CHECKOUT_PASSWORD'};
931
932 #
933 # if a user is given by dasscm configuration file, we use it.
934 # Otherwise we expect that read-only account is configured
935 # as local subversion configuration.
936 # If this is also not the case,
937 # user is required to type username and password.
938 # This will be stored as local subversion configuration thereafter.
939 #
940 if ( $DASSCM_CHECKOUT_USERNAME && $DASSCM_CHECKOUT_PASSWORD ) {
941 $svnCheckoutCredentials =
942 " --username $DASSCM_CHECKOUT_USERNAME --password $DASSCM_CHECKOUT_PASSWORD ";
943 }
944
945 # get command line options and store them in options hash
946 my $result = GetOptions( \%options, 'verbose', 'message=s' );
947
948 # print options
949 foreach my $option ( keys %options ) {
950 print "${option}: $options{$option}\n";
951 }
952
953 # set verbose to command line option
954 $verbose = $options{'verbose'};
955
956 #
957 # action accordinly to command are taken
958 # $command is rewritten in standard format,
959 # so we can test for it later on more simply
960 #
961 $_ = $command;
962 if (m/help/i) {
963 help(@ARGV);
964 } elsif (m/login/i) {
965 $command = "login";
966 login(@ARGV);
967 } elsif (m/init/i) {
968 $command = "init";
969 init(@ARGV);
970 } elsif (m/ls/i) {
971 $command = "ls";
972 ls(@ARGV);
973 } elsif ( (m/update/i) || (m/up/i) ) {
974 $command = "update";
975 update(@ARGV);
976 } elsif (m/add/i) {
977 $command = "add";
978 add(@ARGV);
979 } elsif ( (m/commit/i) || (m/ci/i) ) {
980 $command = "commit";
981 add(@ARGV);
982 } elsif (m/blame/i) {
983 $command = "blame";
984 blame(@ARGV);
985 } elsif (m/diff/i) {
986 $command = "diff";
987 diff(@ARGV);
988 } elsif ( (m/status/i) || (m/st/i) ) {
989 $command = "status";
990 $return_code = status(@ARGV);
991 } elsif (m/permissions/i) {
992 $command = "permissions";
993 permissions(@ARGV);
994 } else {
995 print "unknown command: $command\n\n";
996 usage();
997 check_env();
998 $return_code = $RETURN_NOK;
999 }
1000
1001 # cleanup (svn-commit.tmp)
1002 # commitall
1003 # revert
1004 # activate
1005 # rm
1006
1007}
1008
1009exit $return_code;
Note: See TracBrowser for help on using the repository browser.