source: trunk/dasscm/dasscm@ 247

Last change on this file since 247 was 247, checked in by joergs, on Oct 13, 2008 at 6:04:39 PM

bugfix, better error handling for changing checkout user credentials

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