source: dasscm/trunk/dasscm@ 800

Last change on this file since 800 was 800, checked in by joergs, on Nov 10, 2009 at 6:00:44 PM

added revert

  • Property keyword set to id
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 36.0 KB
RevLine 
[186]1#!/usr/bin/perl -w
2
3# $Id: dasscm 800 2009-11-10 17:00:44Z 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
[253]26# shell exit codes
[252]27my $RETURN_OK = 0;
28my $RETURN_NOK = 1;
29
[277]30# Nagios return codes
[290]31my $RETURN_WARN = 1;
32my $RETURN_CRIT = 2;
[277]33my $RETURN_UNKNOWN = 3;
34
[238]35# documentation file (for usage)
36my $doc_file = "/usr/share/doc/packages/dasscm/dasscm_howto.txt";
37
[253]38# commands that require write access (and therefore a login)
39# to the repository server
[274]40my @COMMANDS_REQUIRE_WRITE = ( "add", "commit" );
[252]41
[215]42# configuration file
[205]43my $config_file = "/etc/dasscm.conf";
[234]44my $config = get_config($config_file);
[205]45my $DASSCM_LOCAL_REPOSITORY_BASE;
46my $DASSCM_REPOSITORY_NAME;
47my $DASSCM_SVN_REPOSITORY;
[247]48my $DASSCM_CHECKOUT_USERNAME;
49my $DASSCM_CHECKOUT_PASSWORD;
[286]50my $DASSCM_PERMISSION_FILE;
[205]51
[238]52# current directory at program start
53my $StartDirectory = cwd();
54
[268]55my $diff = "diff --exclude .svn ";
[205]56my $SVN = "svn ";
57my $svnOptions = "";
58my $svnCheckoutCredentials = "";
59my $svnPasswordCredentials = "";
[275]60
[268]61# flag. Set to true by svn_update
62# This prevents, that svn_update is called multiple times
63my $svnRepositoryIsUptodate = 0;
[205]64
[196]65# command line options get stored in options hash
[205]66my %options = ();
67
[197]68# subcommand, that gets executed (add, commit, ...)
[196]69my $command;
[186]70
[205]71my $verbose = 0;
72
[189]73#####################################################################
74#
[186]75# util functions
[189]76#
[187]77sub usage()
78{
[283]79 print '$Id: dasscm 800 2009-11-10 17:00:44Z joergs $';
80 print "\n\n";
[205]81 print "usage: dasscm <subcommand> [options] [args]\n";
82 print "\n";
83 print "dasscm is intended to help versioning configuration files\n";
84 print "\n";
85 print "Available subcommands:\n";
[215]86 print " help <subcommand>\n";
[205]87 print " init\n";
[274]88 print " login <username>\n";
89 print " up <path>\n";
90 print " ls <path>\n";
91 print " add <path>\n";
92 print " commit <path>\n";
[800]93 print " revert <path>\n";
[274]94 print " diff <path>\n";
95 print " status <path>\n";
[277]96 print " check\n";
[274]97 print " cleanup\n";
[215]98 print " permissions\n";
[205]99 print "\n";
[800]100 print "If dasscm is not yet configured, read $doc_file\n";
[187]101}
102
[233]103sub warning(@)
104{
105 print "Warning: " . join( "\n ", @_ ) . "\n";
106}
107
108sub error(@)
109{
110 print "Error: " . join( "\n ", @_ ) . "\n";
111}
112
113sub fatalerror(@)
114{
[239]115 error(@_);
116
[233]117 #print "Exiting\n";
[239]118 exit 1;
[233]119}
120
[238]121#
122# reading config file and return key/value pairs as hash
123#
[234]124sub get_config
125{
[239]126 my $file = $_[0];
[234]127
[239]128 if ( !$file ) {
[234]129 fatalerror( "failed to open config file" . $file );
130 }
131
132 my $data = {};
133
134 # try to open config file
135 if ( !open( FH, $file ) ) {
136 fatalerror( "failed to open config file" . $file );
137 } else {
138 while (<FH>) {
139 chomp;
140 if (/^#/) {
141 next;
142 }
143 if ( $_ =~ /=/g ) {
[239]144
[238]145 # splitting in 2 fields at maximum
[234]146 my ( $option, $value ) = split( /=/, $_, 2 );
147 $option =~ s/^\s+//g;
148 $option =~ s/\s+$//g;
149 $option =~ s/\"+//g;
150 $value =~ s/^\s+//g;
151 $value =~ s/\s+$//g;
152 $value =~ s/\"+//g;
153
154 if ( length($option) ) {
155 $data->{$option} = $value;
156 }
157 }
158 }
159 }
160 close(FH);
161
162 return $data;
163}
164
[270]165#
166# check and evaluate environment variables
167#
[186]168sub check_env()
169{
[205]170
171 # DASSCM_PROD
172 if ( !$DASSCM_PROD ) {
173 $DASSCM_PROD = "/";
174 }
175
176 if ( !-d $DASSCM_PROD ) {
177 die "DASSCM_PROD ($DASSCM_PROD) is not set to a directory.\n";
178 }
179 if ($verbose) { print "DASSCM_PROD: " . $DASSCM_PROD . "\n"; }
180
181 # DASSCM_REPOSITORY_NAME
[208]182 if ( !$DASSCM_REPOSITORY_NAME ) {
183 die
184 "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";
185 }
[205]186
187 # DASSCM_REPO
188 if ( !$DASSCM_REPO ) {
189 if ( $DASSCM_LOCAL_REPOSITORY_BASE && $DASSCM_REPOSITORY_NAME ) {
190 $DASSCM_REPO =
191 $DASSCM_LOCAL_REPOSITORY_BASE . "/" . $DASSCM_REPOSITORY_NAME;
192 } else {
193 die
194 "Envirnonment variable DASSCM_REPO not set.\nSet DASSCM_REPO to the directory of the versioning system checkout for this machine.\n";
195 }
196 }
[215]197 if ($verbose) { print "DASSCM_REPO: " . $DASSCM_REPO . "\n"; }
[205]198
199 #
[248]200 # subversion checkout user
201 #
[252]202 if ( !$DASSCM_CHECKOUT_USERNAME ) {
203 fatalerror(
[248]204 "variable DASSCM_CHECKOUT_USERNAME is not defined.",
[252]205 "Use file $config_file to configure it."
206 );
[248]207 }
208
[252]209 if ( !$DASSCM_CHECKOUT_PASSWORD ) {
210 fatalerror(
[248]211 "variable DASSCM_CHECKOUT_PASSWORD is not defined.",
[252]212 "Use file $config_file to configure it."
213 );
[248]214 }
215
216 #
[239]217 # check if local repository directory exist
[235]218 # (if not creating by init)
[205]219 #
220 if ( $command ne "init" ) {
221 if ( not -d $DASSCM_REPO ) {
222 die
[208]223 "Can't access local repository DASSCM_REPO\n($DASSCM_REPO)\nCheck configuration and execute\n dasscm init\n";
[205]224 }
[208]225
[205]226 #
227 # user settings
228 #
[208]229
[205]230 # DASSCM_USER is legacy. Use DASSCM_USERNAME instead
[208]231 if ( !$DASSCM_USERNAME ) {
232 $DASSCM_USERNAME = $DASSCM_USER;
[205]233 }
234
235 # user root is not allowed for checkins.
236 # if user is root, DASSCM_USER has to be set,
237 # otherwise USER can be used
238 if ( "$USER" eq "root" ) {
[252]239 if ( ( not $DASSCM_USERNAME )
240 and ( grep { m|^$command$| } @COMMANDS_REQUIRE_WRITE ) )
241 {
242
243 #( $command ne "login" ) and ( $command ne "status" ) ) {
244 fatalerror(
245 "Envirnonment variable DASSCM_USERNAME not set.",
246 "Set DASSCM_USERNAME to your subversion user account or",
247 "use 'dasscm login'"
248 );
[205]249 }
250 $svnOptions .= " --no-auth-cache ";
251 } elsif ( !$DASSCM_USERNAME ) {
252 $DASSCM_USERNAME = $USER;
253 }
254
255 #
256 # password
257 #
[208]258 if ($DASSCM_PASSWORD) {
[267]259 $svnPasswordCredentials = " --password '$DASSCM_PASSWORD' ";
[205]260 }
261 }
262
263 #$svnOptions .= " --username $DASSCM_USERNAME "
[186]264}
265
[270]266#
267# has been intendend,
268# to check addtitional parameters.
269# Currently not used.
270#
[186]271sub check_parameter(@)
272{
273}
274
[238]275#
[287]276# normalize path namens:
277# - directories should end with "/"
278# - use only single "/"
279#
280sub normalize_path($)
281{
282 my $path = shift || "";
283
[290]284 if ( $path =~ m|^/| ) {
285
[287]286 # full path
[290]287 if ( -d $path ) {
288
[287]289 # ensure, a directory ends with '/'
290 $path .= '/';
291 }
[290]292 } elsif ( -d cwd() . '/' . $path ) {
293
294 # ensure, a directory ends with '/'
295 $path .= '/';
[287]296 }
297
298 # remove double (triple) slashes (/)
299 $path =~ s|/[/]*|/|g;
300
301 return $path;
302}
303
304#
[239]305# generate from (relative) filename
[238]306# all required file and directory names:
307# $basename, $dirname_prod, $dirname_repo,
308# $filename_prod, $filename_repo
309#
[187]310sub get_filenames(@)
311{
[250]312 my $filename_prod = $_[0] || ".";
[237]313
[238]314 # make filename absolut
[205]315 if ( !( $filename_prod =~ m/^\// ) ) {
[270]316 $filename_prod = cwd() . '/' . $filename_prod;
[205]317 }
[187]318
[800]319 # file must be readable. Only exception is, when file should be reverted
320 if ( $command ne "revert" ) {
321 if ( not -r $filename_prod ) {
322 fatalerror( $filename_prod . " is not accessable" );
323 }
[233]324 }
[205]325
[274]326 # dirname buggy: eg. "/etc/" is reduced to "/",
327 # "/etc" is used as filename
328 # herefore make sure, that if filename is a directory,
329 # it will end by "/"
[290]330 $filename_prod = normalize_path($filename_prod);
[238]331
[270]332 ( my $basename, my $dirname_prod ) = fileparse($filename_prod);
333
[800]334 # normalize path.
335 # not done for reverting, because in this case, the directory may not exist
336 # and the correct path should already be stored in the repository
337 if ( $command ne "revert" ) {
338 # uses chdir to determine real directory in a unique way
339 chdir $dirname_prod or fatalerror( "failed to access directory $dirname_prod: " . $! );
340 $dirname_prod = normalize_path( cwd() );
341 chdir $StartDirectory;
342 }
[238]343
[287]344 my $dirname_repo = normalize_path( $DASSCM_REPO . "/" . $dirname_prod );
[290]345 my $filename_repo = normalize_path("$dirname_repo/$basename");
[287]346
[214]347 if ($verbose) {
[287]348 print "filename_repo: " . $filename_repo . "\n";
[290]349 print "dirname_repo: " . $dirname_repo . "\n";
[287]350 print "filename_prod: " . $filename_prod . "\n";
[290]351 print "dirname_prod: " . $dirname_prod . "\n";
[287]352 print "basename: " . $basename . "\n";
[214]353 }
[205]354
355 return (
356 $basename, $dirname_prod, $dirname_repo,
357 $filename_prod, $filename_repo
358 );
[187]359}
360
[271]361sub copy_file_to_repository( $ )
362{
363 my $filename = shift;
[256]364
[271]365 (
366 my $basename,
367 my $dirname_prod,
368 my $dirname_repo,
369 my $filename_prod,
370 my $filename_repo
[275]371 )
372 = get_filenames($filename);
[271]373
374 # TODO: are permissions also copied?
375 copy( $filename_prod, $filename_repo )
[275]376 or error "failed to copy $filename_prod to repository: $!";
[271]377}
378
[800]379
[256]380#
381# creates a file with permissions
382#
[215]383sub generatePermissionList
[209]384{
385
[215]386 # generieren der Zeilen für Permission-Savefile
387 my @files = @_;
388 my @permlist = ();
389 foreach my $file (@files) {
[227]390 $file = "/" . $file;
[239]391 if ( -e $file ) {
392 my $info = stat($file) || die "failed to stat $file: aborting";
393 my $mode = get_type( $info->mode ) & 07777;
[227]394 my $modestring = sprintf( "%04o", $mode );
[278]395 my $uidnumber = $info->uid;
396 my $uid = getpwuid($uidnumber) || $uidnumber;
397 my $gidnumber = $info->gid;
398 my $gid = getgrgid($gidnumber) || $gidnumber;
[227]399 push(
400 @permlist,
401 sprintf( "%-55s %-17s %4d",
[278]402 $file, "${uid}:${gid}", $modestring )
[227]403 );
404 }
[215]405 }
406 return @permlist;
407}
[209]408
[215]409sub get_type
410{
[209]411
[215]412 # Funktion übernommen aus /usr/bin/chkstat
413 my $S_IFLNK = 0120000; # symbolic link
414 my $S_IFREG = 0100000; # regular file
415 my $S_IFDIR = 0040000; # directory
416 my $S_IFCHAR = 0020000; # character device
417 my $S_IFBLK = 0060000; # block device
418 my $S_IFFIFO = 0010000; # fifo
419 my $S_IFSOCK = 0140000; # socket
420 my $S_IFMT = 0170000; # type of file
[209]421
[215]422 my $S_m;
423 if ( ( $_[0] & $S_IFMT ) == $S_IFLNK ) { $S_m = $_[0] - $S_IFLNK; }
424 elsif ( ( $_[0] & $S_IFMT ) == $S_IFREG ) { $S_m = $_[0] - $S_IFREG; }
425 elsif ( ( $_[0] & $S_IFMT ) == $S_IFDIR ) { $S_m = $_[0] - $S_IFDIR; }
426 elsif ( ( $_[0] & $S_IFMT ) == $S_IFCHAR ) { $S_m = $_[0] - $S_IFCHAR; }
427 elsif ( ( $_[0] & $S_IFMT ) == $S_IFBLK ) { $S_m = $_[0] - $S_IFBLK; }
428 elsif ( ( $_[0] & $S_IFMT ) == $S_IFFIFO ) { $S_m = $_[0] - $S_IFFIFO; }
429 elsif ( ( $_[0] & $S_IFMT ) == $S_IFSOCK ) { $S_m = $_[0] - $S_IFSOCK; }
430 $S_m;
[209]431}
432
[186]433sub run_command
434{
[205]435 my $command = shift;
[186]436
[205]437 #print "executing command: " . $command . "\n";
[186]438
[205]439 open( RESULT, $command . ' 2>&1 |' );
440 my @result = <RESULT>;
441 close(RESULT);
442 my $retcode = $? >> 8;
[186]443
[205]444 #print @result;
445 #if( $retcode ) { print "return code: " . $retcode . "\n"; }
[186]446
[205]447 return ( $retcode, @result );
[186]448}
449
[205]450sub run_interactive
451{
[186]452
[208]453 if ($verbose) {
[205]454 print "run_interactive:" . join( " ", @_ ) . "\n";
455 }
[196]456
[205]457 system(@_);
458 if ( $? == -1 ) {
459 printf "failed to execute: $!\n";
460 } elsif ( $? & 127 ) {
461 printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
462 ( $? & 128 ) ? 'with' : 'without';
463 } elsif ( $? >> 8 != 0 ) {
464 printf "child exited with value %d\n", $? >> 8;
465 }
466 return ( $? >> 8 );
467}
468
[247]469sub svn_check_credentials( $$;$$ )
[196]470{
[205]471 my $username = shift;
472 my $password = shift;
473
[252]474 # check silently are allow user interaction?
[247]475 my $interactive = shift || 0;
[220]476
[247]477 # default: exit program, if repository is not accessable
478 # (do not exit for 'init')
479 my $fatalerror = shift || 1;
480
481 print "checking credentials ";
482
[239]483 if ( !$username ) {
484 fatalerror("no username given");
[238]485 }
486
[239]487 if ( !$password ) {
488 fatalerror("no password given");
[238]489 }
490
[247]491 print "for " . $username . "@" . $DASSCM_SVN_REPOSITORY . ": ";
492
[220]493 # Options for "svn info" are not supported by subversion 1.0.0 (SLES9),
494 # therefore switching to "svn status"
495 # ( my $rc_update, my @result ) =
496 # run_command(
497 # "$SVN info --non-interactive --no-auth-cache --username $username --password $password $DASSCM_SVN_REPOSITORY"
498 # );
499 #print @result;
500
[247]501 my $rc_update;
[252]502 if ($interactive) {
503 $rc_update =
504 run_interactive(
[267]505 "$SVN ls --no-auth-cache --username '$username' --password '$password' $DASSCM_SVN_REPOSITORY"
[252]506 );
[247]507 } else {
508 ( $rc_update, my @result ) =
[252]509 run_command(
[267]510 "$SVN ls --non-interactive --no-auth-cache --username '$username' --password '$password' $DASSCM_SVN_REPOSITORY"
[252]511 );
512
[247]513 if ( $rc_update != 0 ) {
514 print "\n", @result;
[252]515 if ($fatalerror) {
[247]516 fatalerror();
517 }
518 return;
519 }
[205]520 }
521
[247]522 # return success
523 return $rc_update == 0;
[196]524}
525
[797]526
527
[205]528sub svn_update( ;$ )
529{
[270]530 my $update_path = shift || "";
531
[797]532 # return value
533 my $update_ok = 1;
534
[270]535 # use this flag to do only one update per run
[275]536 if ( !$svnRepositoryIsUptodate ) {
[268]537 ( my $rc_update, my @result ) =
[275]538 run_command(
539 "$SVN update --non-interactive $svnCheckoutCredentials '$DASSCM_REPO/$update_path'"
540 );
[268]541 print @result;
542 if ( $rc_update != 0 ) {
[290]543 error("failed to update local repository ($update_path)");
[797]544 $update_ok = 0;
[270]545 } elsif ( not $update_path ) {
[275]546
[270]547 # set this flag if a full update is done
[268]548 $svnRepositoryIsUptodate = 1;
549 }
[205]550 }
[797]551 return $update_ok;
[215]552}
[196]553
[797]554
555
[271]556sub svn_ls( ;@ )
[215]557{
[270]558 (
559 my $basename,
560 my $dirname_prod,
561 my $dirname_repo,
562 my $filename_prod,
563 my $filename_repo
564 )
565 = get_filenames( $_[0] );
[220]566
[218]567 # svn ls -R is better, but much, much slower
568 # ( my $rc, my @result ) = run_command("$SVN ls --recursive $svnCheckoutCredentials $path");
[270]569
[271]570 my @files = ();
571 my @links = ();
572 my @dirs = ();
573 my @others = ();
574
[289]575 find(
576 {
577 wanted => sub {
578 my $name = normalize_path($File::Find::name);
579 $name =~ s|^$dirname_repo||;
[290]580
[289]581 #print "($name)\n";# . $File::Find::dir . "\n";
582 if ( not $name ) {
[290]583
[289]584 # name string is empty (top directory).
585 # do nothing
586 } elsif ( $name =~ m/\.svn/ ) {
[275]587
[289]588 # skip svn meta data
589 } elsif ( -l $_ ) {
[275]590
[289]591 # soft link
592 # important: check for links first
593 # to exclude them from further checks
594 push( @links, $name );
595 } elsif ( -d $_ ) {
[290]596
[289]597 #if( $name."/" eq dirname_repo ) {
[290]598 # directories
599 push( @dirs, $name );
600
[289]601 #}
602 } elsif ( -f $_ ) {
[275]603
[289]604 # regular file
605 push( @files, $name );
606 } else {
607 push( @others, $name );
608 }
[290]609 }
[289]610 },
611 ($filename_repo)
612 );
[271]613
[287]614 return ( sort( @dirs, @files ) );
[205]615}
616
[274]617sub svn_revert( ;$ )
618{
619 my $path = shift || $DASSCM_REPO;
620
[275]621 ( my $rc_update, my @result ) = run_command("$SVN revert -R '$path'");
[274]622
623 if ( $rc_update != 0 ) {
624 print "\n", @result;
[275]625 error("failed to revert subversion repository changes");
[274]626 }
627}
628
[285]629sub svn_remove_unknown_files( ;$ )
630{
631 my $path = shift || $DASSCM_REPO;
632
[290]633 ( my $rc_update, my @result ) = run_command("$SVN status '$path'");
[285]634
635 if ( $rc_update != 0 ) {
636 print "\n", @result;
637 error("failed to receive subversion repository information");
638 } else {
[290]639 foreach (@result) {
640 if (s/^\? +//) {
[285]641 chomp;
[290]642
[285]643 # if file is unknown to subversion (line starts with "?")
644 # remove it
645 print "removing $_\n";
[800]646 # unlink doesn't work recursive, there "rm -rf" is used
647 #unlink($_);
648 system( "rm -rf $_" );
[285]649 }
650 }
651 }
652}
653
[268]654sub getModifiedFiles( ;$ )
655{
[270]656 (
657 my $basename,
658 my $dirname_prod,
659 my $dirname_repo,
660 my $filename_prod,
661 my $filename_repo
662 )
663 = get_filenames( $_[0] );
[268]664
[275]665 my @files = svn_ls($filename_prod);
[270]666
[268]667 # stores result from status (cvscheck)
668 my %removedfiles = ();
669 my %changedfiles = ();
[278]670 my %unknownfiles = ();
[268]671
672 # create list of modified files
673 if (@files) {
674
675 foreach my $file (@files) {
676
[271]677 my $realfile = $dirname_prod . $file;
678 my $cvsworkfile = $dirname_repo . $file;
[268]679
680 if ( -d $realfile ) {
[290]681
[278]682 # directory
[290]683 if ( !-d "$cvsworkfile" ) {
684
[278]685 # real is directory, repository is not. This is a problem
686 $changedfiles{"$realfile"} = $cvsworkfile;
687 }
688 } elsif ( !-e $realfile ) {
689 $removedfiles{"$realfile"} = $cvsworkfile;
[268]690 } elsif ( !-r $realfile ) {
[290]691
[278]692 # don't have permission to read the file,
693 # can't check it
694 $unknownfiles{"$realfile"} = $cvsworkfile;
[268]695 } else {
696 ( -r "$cvsworkfile" )
[278]697 || fatalerror("failed to read $cvsworkfile");
[268]698 if ( compare( $cvsworkfile, $realfile ) != 0 ) {
699 $changedfiles{"$realfile"} = $cvsworkfile;
700 }
701 }
702 }
703 }
704
[278]705 return ( \%changedfiles, \%removedfiles, \%unknownfiles );
[268]706}
707
[238]708#
709# from an array of files/dirs,
710# generates list of files
711# sorted by type
712#
[237]713sub get_files( @ )
714{
715 my @files = ();
716 my @links = ();
717 my @dirs = ();
718 my @others = ();
719
[239]720 if (@_) {
721 find(
722 {
723 wanted => sub {
724 my $fullname = cwd() . "/" . $_;
725 if ( -l $_ ) {
726
727 # soft link
728 # important: check for links first
729 # to exclude them from further checks
730 push( @links, $fullname );
731 } elsif ( -d $_ ) {
[271]732
733 # directories
[239]734 push( @dirs, $fullname );
735 } elsif ( -f $_ ) {
736
737 # regular file
738 push( @files, $fullname );
739 } else {
740 push( @others, $fullname );
741 }
742 }
743 },
744 @_
745 );
[237]746 }
747
[239]748 # don't rely on others.
[237]749 # If more specific file types are needed,
750 # they will be added
751 return {
[239]752 files => \@files,
753 links => \@links,
754 dirs => \@dirs,
755 others => \@others
756 };
[237]757}
758
[189]759#####################################################################
760#
[186]761# functions
762
763sub help(;@)
764{
[205]765 if ( @_ == 0 ) {
766 usage();
767 } else {
768 print "help for @_: ...\n";
[214]769 usage();
[205]770 }
[186]771}
772
[203]773sub login(@)
774{
[205]775 check_parameter( @_, 1 );
776 check_env();
[203]777
[235]778 my $input_username = $_[0];
[214]779
780 if ( not $input_username ) {
781 my $output_username = "";
782 if ($DASSCM_USERNAME) {
783 $output_username = " ($DASSCM_USERNAME)";
784 }
785
786 print "Enter DASSCM user name", $output_username, ": ";
787 $input_username = <STDIN>;
788 chomp($input_username);
[247]789
790 $input_username = $input_username || $DASSCM_USERNAME;
[205]791 }
[203]792
[205]793 # hidden password input
[247]794 print "Enter password for $input_username: ";
[205]795 ReadMode('noecho');
796 my $input_password = <STDIN>;
797 ReadMode('normal');
798 chomp($input_password);
[220]799 print "\n";
[203]800
[247]801 # checking checkout username/password
[252]802 svn_check_credentials( $DASSCM_CHECKOUT_USERNAME,
803 $DASSCM_CHECKOUT_PASSWORD );
[247]804 print "checkout access okay\n";
[205]805
[247]806 svn_check_credentials( $input_username, $input_password );
807
[205]808 #
809 # set environment variables
810 #
[267]811 $ENV{'DASSCM_USERNAME'} = "$input_username";
812 $ENV{'DASSCM_PASSWORD'} = "$input_password";
[205]813
[209]814 print "subversion access okay\n\n", "DASSCM_USERNAME: $input_username\n",
815 "DASSCM_PASSWORD: (hidden)\n", "DASSCM_PROD: $DASSCM_PROD\n",
816 "DASSCM_REPO: $DASSCM_REPO\n",
[278]817 "Server Repository: $DASSCM_SVN_REPOSITORY\n", "\n";
[205]818
[278]819 status();
820
821 print "\n[dasscm shell]\n\n";
[235]822 my $shell = $SHELL || "bash";
823 exec($shell) or die "failed to start new shell";
[203]824}
825
[260]826#
827# initialize local checkout directory (initial checkout)
828#
[205]829sub init(@)
830{
831 check_parameter( @_, 1 );
832 check_env();
833
[235]834 # don't do repository creation (svn mkdir) here,
835 # because then their must be a lot of prior checks
836
[205]837 # update complete repository
[216]838 # and create permission file
[208]839 my $retcode =
840 run_interactive(
[286]841 "cd $DASSCM_LOCAL_REPOSITORY_BASE; $SVN checkout $svnCheckoutCredentials $svnOptions $DASSCM_SVN_REPOSITORY; mkdir -p `dirname $DASSCM_PERMISSION_FILE`; touch $DASSCM_PERMISSION_FILE"
[208]842 );
[205]843}
844
[215]845sub ls(@)
[186]846{
[205]847 check_parameter( @_, 1 );
848 check_env();
[186]849
[271]850 my @files = svn_ls(@_);
[215]851
[275]852 if (@files) {
[274]853 print join( "\n", @files );
854 print "\n";
855 }
[215]856}
857
858sub update(@)
859{
860 check_parameter( @_, 1 );
861 check_env();
862
863 #
864 # update local repository
865 #
866 svn_update();
867}
868
[237]869#
870# helper function for "add" command
871#
[215]872sub add_helper(@)
873{
[205]874 (
875 my $basename,
876 my $dirname_prod,
877 my $dirname_repo,
878 my $filename_prod,
879 my $filename_repo
880 )
881 = get_filenames( $_[0] );
[186]882
[274]883 mkpath($dirname_repo);
[186]884
[238]885 # TODO: are permissions also copied?
[239]886 copy( $filename_prod, $filename_repo )
887 or error "failed to copy $filename_prod to repository: $!";
[205]888
[274]889 # already checked in?
890 chdir $DASSCM_REPO;
[205]891
[274]892 # also add the path to filename.
893 for my $dir ( split( '/', $dirname_prod ) ) {
894 if ($dir) {
[275]895 my ( $rc, @out ) = run_command("$SVN add --non-recursive '$dir'");
[274]896 if ( $rc > 0 ) {
897 print join( "\n", @out );
[205]898 }
[274]899 chdir $dir;
[205]900 }
901 }
[275]902 my ( $rc, @out ) = run_command("$SVN add '$basename'");
[274]903 if ( $rc > 0 ) {
904 print join( "\n", @out );
905 }
906 chdir $StartDirectory;
907
[215]908}
[205]909
[215]910#
[274]911# adding new files (or directories)
[215]912#
913sub add(@)
914{
915 check_parameter( @_, 1 );
916 check_env();
917
918 #
919 # update local repository
920 #
921 svn_update();
922
[237]923 # get all regular files and links
[239]924 my $href_files = get_files(@_);
[220]925
[237]926 #print Dumper( $href_files );
927
[239]928 my @files = @{ $href_files->{files} };
929 my @links = @{ $href_files->{links} };
[237]930
[239]931 if (@files) {
[237]932 my $number = $#files + 1;
933 print "files to check-in ($number): \n";
934 print join( "\n", @files );
935 print "\n";
936 }
937
[268]938 # TODO: check in links and also link target? At least warn about link target
[239]939 if (@links) {
[237]940 my $number = $#links + 1;
941 print "\n";
942 print "ignoring links ($number):\n";
943 print join( "\n", @links );
944 print "\n";
945 }
946
[238]947 # TODO: confirm
948
[237]949 # copy files one by one to local repository
950 for my $file (@files) {
[239]951
[233]952 # add file
[239]953 add_helper($file);
[233]954 }
955
[215]956 # create new permissions file
957 permissions();
[220]958
[215]959 # add permissions file
[286]960 add_helper($DASSCM_PERMISSION_FILE);
[215]961
[205]962 if ( $options{'message'} ) {
963 $svnOptions .= " --message \"$options{'message'}\" ";
964 }
965
[239]966 # commit calls $EDITOR.
[237]967 # use "interactive" here, to display output
[215]968 my $retcode =
[205]969 run_interactive(
[267]970 "$SVN commit $svnOptions --username '$DASSCM_USERNAME' $svnPasswordCredentials $DASSCM_REPO"
[208]971 );
[205]972
[274]973 # svn commit does not deliever an error return code, if commit is canceld,
974 # so a revert is performed in any case
975 svn_revert();
[186]976}
977
[271]978#
979# checks in all modified files
980#
981sub commit(@)
982{
983 check_parameter( @_, 1 );
984 check_env();
985
986 (
987 my $basename,
988 my $dirname_prod,
989 my $dirname_repo,
990 my $filename_prod,
991 my $filename_repo
[275]992 )
993 = get_filenames( $_[0] );
[271]994
995 #
996 # update local repository
997 #
998 svn_update();
999
[275]1000 ( my $refChangedFiles, my $refRemovedFiles ) =
1001 getModifiedFiles($filename_prod);
[271]1002 my %changedfiles = %{$refChangedFiles};
1003 my %removedfiles = %{$refRemovedFiles};
1004
[275]1005 if (%removedfiles) {
1006 my $removedFilesString =
1007 '"' . join( '" "', values(%removedfiles) ) . '"';
1008 my ( $rc, @out ) = run_command("$SVN rm $removedFilesString");
[271]1009 if ( $rc > 0 ) {
1010 print join( "\n", @out );
1011 }
1012 }
1013
1014 # copy files one by one to local repository
1015 for my $file ( keys(%changedfiles) ) {
[275]1016 copy_file_to_repository($file);
[271]1017 }
1018
1019 # create new permissions file
1020 permissions();
1021
1022 # add permissions file
[286]1023 add_helper($DASSCM_PERMISSION_FILE);
[271]1024
1025 if ( $options{'message'} ) {
1026 $svnOptions .= " --message \"$options{'message'}\" ";
1027 }
1028
1029 # commit calls $EDITOR.
1030 # use "interactive" here, to display output
1031 my $retcode =
1032 run_interactive(
1033 "$SVN commit $svnOptions --username '$DASSCM_USERNAME' $svnPasswordCredentials $DASSCM_REPO"
1034 );
[274]1035
1036 # svn commit does not deliever an error return code, if commit is canceld,
1037 # so a revert is performed in any case
1038 svn_revert();
[271]1039}
1040
[800]1041
1042
1043#
1044# revert: copies files back from repository to system
1045#
1046sub revert(@)
1047{
1048 check_parameter( @_, 1 );
1049 check_env();
1050
1051 (
1052 my $basename,
1053 my $dirname_prod,
1054 my $dirname_repo,
1055 my $filename_prod,
1056 my $filename_repo
1057 )
1058 = get_filenames( $_[0] );
1059
1060 # return code for the shell
1061 # default: error
1062 my $return_code = $RETURN_OK;
1063
1064
1065 # cleanup repository
1066 ##cleanup();
1067 #svn_update();
1068
1069 ( my $refChangedFiles, my $refRemovedFiles, my $refUnknownFiles ) =
1070 getModifiedFiles($filename_prod);
1071 my %changedfiles = %{$refChangedFiles};
1072 my %removedfiles = %{$refRemovedFiles};
1073 my %unknownfiles = %{$refUnknownFiles};
1074
1075 if ( %removedfiles or %changedfiles or %unknownfiles ) {
1076
1077 if (%removedfiles) {
1078 print "DELETED files and directories. Recreated from repository:\n";
1079 my @removedPaths = ( sort { length $a > length $b } keys %removedfiles );
1080 print join( "\n", @removedPaths ) . "\n\n";
1081
1082 # copy files one by one from local repository to system
1083 # and also create directories
1084 # paths are sorted, so that directories are created first
1085 for my $real_path ( @removedPaths ) {
1086 if( -d $removedfiles{"$real_path"} ) {
1087 mkpath("$real_path");
1088 } else {
1089 copy( $removedfiles{"$real_path"}, $real_path ) or error( "failed to copy " . $removedfiles{"$real_path"} . " to " . $real_path . ": " . $! );
1090 }
1091 }
1092 }
1093
1094 if (%changedfiles) {
1095 print "MODIFIED files. Copied from repository to the system:\n";
1096 print join( "\n", ( keys %changedfiles ) ) . "\n\n";
1097
1098 # copy files one by one from local repository to system
1099 for my $real_file ( keys(%changedfiles) ) {
1100 copy( $changedfiles{"$real_file"}, $real_file );
1101 }
1102
1103 }
1104
1105 if (%unknownfiles) {
1106 print "UNKNOWN: insufficient permission to check files:\n";
1107 print join( "\n", ( keys %unknownfiles ) ) . "\n\n";
1108
1109 $return_code = $RETURN_NOK;
1110 }
1111
1112 } else {
1113 print "no modified files found in $dirname_repo\n";
1114 }
1115
1116 return $return_code;
1117}
1118
1119
1120
[193]1121sub blame(@)
1122{
[205]1123 check_parameter( @_, 1 );
1124 check_env();
[193]1125
[205]1126 (
1127 my $basename,
1128 my $dirname_prod,
1129 my $dirname_repo,
1130 my $filename_prod,
1131 my $filename_repo
1132 )
1133 = get_filenames( $_[0] );
1134
1135 my $retcode = run_interactive("$SVN blame $svnOptions $filename_repo");
[193]1136}
1137
[187]1138sub diff(@)
1139{
[205]1140 check_parameter( @_, 1 );
1141 check_env();
[187]1142
[205]1143 (
1144 my $basename,
1145 my $dirname_prod,
1146 my $dirname_repo,
1147 my $filename_prod,
1148 my $filename_repo
1149 )
1150 = get_filenames( $_[0] );
1151
1152 #print "$basename,$dirname_prod,$dirname_repo\n";
1153
[797]1154 svn_update();
[205]1155
[238]1156 ( my $rc_diff, my @diff_result ) =
[239]1157 run_command( $diff . " $filename_repo $filename_prod" );
[238]1158
1159 print @diff_result;
[187]1160}
1161
[209]1162sub status(@)
1163{
1164 check_parameter( @_, 1 );
1165 check_env();
1166
[270]1167 (
1168 my $basename,
1169 my $dirname_prod,
1170 my $dirname_repo,
1171 my $filename_prod,
1172 my $filename_repo
1173 )
1174 = get_filenames( $_[0] || "/" );
1175
[252]1176 # return code for the shell
1177 # default: error
1178 my $return_code = $RETURN_NOK;
1179
[209]1180 #
1181 # update local repository
1182 #
[278]1183 #svn_update( $filename_prod );
[209]1184
[278]1185 # check, if permissions have changed
1186 permissions();
1187
1188 # get modified files
1189 ( my $refChangedFiles, my $refRemovedFiles, my $refUnknownFiles ) =
[275]1190 getModifiedFiles($dirname_prod);
[268]1191 my %changedfiles = %{$refChangedFiles};
1192 my %removedfiles = %{$refRemovedFiles};
[278]1193 my %unknownfiles = %{$refUnknownFiles};
[209]1194
[278]1195 if ( %removedfiles or %changedfiles or %unknownfiles ) {
1196
[215]1197 if (%removedfiles) {
[278]1198 print "DELETED: files found in repository, but not in system:\n";
[800]1199 print join( "\n", sort ( keys %removedfiles ) ) . "\n\n";
[209]1200 }
1201
[215]1202 if (%changedfiles) {
[278]1203 print "MODIFIED: files differs between repository and system:\n";
1204 print join( "\n", ( keys %changedfiles ) ) . "\n\n";
[209]1205 }
[278]1206
1207 if (%unknownfiles) {
1208 print "UNKNOWN: insufficient permission to check files:\n";
1209 print join( "\n", ( keys %unknownfiles ) ) . "\n\n";
1210 }
1211
[209]1212 } else {
[270]1213 print "no modified files found in $dirname_repo\n";
[252]1214 $return_code = $RETURN_OK;
[209]1215 }
[215]1216
[252]1217 return $return_code;
[215]1218}
[209]1219
[277]1220#
1221# return short status in Nagios plugin conform way
1222#
1223sub check()
1224{
1225 check_env();
1226
1227 # return code for the shell
[290]1228 my $return_code = $RETURN_OK;
[277]1229 my $return_string = "OK: no modified files";
1230
[278]1231 # check, if permissions have changed
1232 permissions();
1233
1234 # get modified files
1235 ( my $refChangedFiles, my $refRemovedFiles, my $refUnknownFiles ) =
[290]1236 getModifiedFiles("/");
[277]1237 my %changedfiles = %{$refChangedFiles};
1238 my %removedfiles = %{$refRemovedFiles};
[278]1239 my %unknownfiles = %{$refUnknownFiles};
[277]1240
1241 if ( %removedfiles or %changedfiles ) {
1242 $return_string = "Warning: ";
[290]1243 if (%changedfiles) {
1244 $return_string .=
1245 "changed: " . join( ", ", ( keys %changedfiles ) ) . ". ";
[277]1246 }
[290]1247 if (%removedfiles) {
1248 $return_string .=
1249 "removed: " . join( ", ", ( keys %removedfiles ) ) . ". ";
[277]1250 }
[278]1251 if (%unknownfiles) {
[290]1252 $return_string .=
1253 "unknown: " . join( ", ", ( keys %unknownfiles ) ) . ". ";
[278]1254 }
[277]1255 $return_code = $RETURN_WARN;
1256 }
1257
1258 # addition nagios Service Status
1259 #Critical
1260 #Unknown
1261
[290]1262 print "$return_string\n";
[277]1263 return $return_code;
1264}
1265
[270]1266sub permissions()
[215]1267{
1268 check_env();
1269
[278]1270 my $return_code = $RETURN_OK;
1271
[215]1272 #
1273 # update local repository
1274 #
1275 #svn_update();
1276
[220]1277 my $dir = $DASSCM_REPO;
[275]1278 my @files = svn_ls("/");
[215]1279
1280 if (@files) {
1281
1282 # generieren der Permissions
1283 my @permissions = generatePermissionList(@files);
1284 my $OUTFILE;
1285 my $tofile = 0; # Status für schreiben in File
[220]1286
[286]1287 if ( -w dirname($DASSCM_PERMISSION_FILE) ) {
[215]1288
1289 # Verzeichnis existiert => schreiben
[286]1290 open( OUTFILE, ">$DASSCM_PERMISSION_FILE" )
1291 || die("failed to write to $DASSCM_PERMISSION_FILE: $!");
[215]1292 $tofile = 1; # Merken, daß in File geschrieben wird
1293 print OUTFILE "#\n";
1294 print OUTFILE "# created by dasscm permissions\n";
[220]1295 print OUTFILE
1296 "# It is intended to be used for restoring permissions\n";
[287]1297 print OUTFILE "#\n";
[215]1298 } else {
1299
[290]1300 if ( $command eq "permission" ) {
1301
[278]1302 # Pfad für Sicherungsdatei existiert nicht => schreiben auf stdout
1303 # Alias Filehandle für stdout erzeugen
1304 $return_code = $RETURN_WARN;
[290]1305 *OUTFILE = *STDOUT;
[278]1306 } else {
[290]1307
[278]1308 # TODO: improve this. Check for diff?
1309 $return_code = $RETURN_CRIT;
1310 return $return_code;
1311 }
[215]1312 }
[278]1313
[215]1314 foreach my $line (@permissions) {
1315 print OUTFILE "$line\n";
1316 }
1317
[220]1318 if ($tofile) {
[215]1319 close(OUTFILE);
1320 }
1321 }
[278]1322
1323 return $return_code;
[209]1324}
1325
[274]1326#
1327# remove all uncommited changes in the repository
1328#
1329sub cleanup()
1330{
1331 check_env();
[268]1332
[275]1333 svn_revert($DASSCM_REPO);
[285]1334 svn_remove_unknown_files($DASSCM_REPO);
[274]1335}
1336
[189]1337#####################################################################
1338#
[186]1339# main
[189]1340#
[186]1341
[252]1342my $return_code = $RETURN_OK;
[186]1343my $number_arguments = @ARGV;
1344
[205]1345if ( $number_arguments > 0 ) {
[186]1346
[205]1347 # get subcommand and remove it from @ARGV
1348 $command = $ARGV[0];
1349 shift @ARGV;
[196]1350
[205]1351 $DASSCM_LOCAL_REPOSITORY_BASE = $config->{'DASSCM_LOCAL_REPOSITORY_BASE'};
1352 $DASSCM_REPOSITORY_NAME = $config->{'DASSCM_REPOSITORY_NAME'};
[196]1353
[205]1354 # TODO: check variables
1355 $DASSCM_SVN_REPOSITORY =
1356 $config->{'DASSCM_SVN_REPOSITORY_BASE'} . "/" . $DASSCM_REPOSITORY_NAME;
1357
[247]1358 $DASSCM_CHECKOUT_USERNAME = $config->{'DASSCM_CHECKOUT_USERNAME'};
1359 $DASSCM_CHECKOUT_PASSWORD = $config->{'DASSCM_CHECKOUT_PASSWORD'};
[205]1360
1361 #
1362 # if a user is given by dasscm configuration file, we use it.
1363 # Otherwise we expect that read-only account is configured
1364 # as local subversion configuration.
1365 # If this is also not the case,
1366 # user is required to type username and password.
1367 # This will be stored as local subversion configuration thereafter.
1368 #
1369 if ( $DASSCM_CHECKOUT_USERNAME && $DASSCM_CHECKOUT_PASSWORD ) {
1370 $svnCheckoutCredentials =
1371 " --username $DASSCM_CHECKOUT_USERNAME --password $DASSCM_CHECKOUT_PASSWORD ";
1372 }
1373
[290]1374 $DASSCM_PERMISSION_FILE = $config->{'DASSCM_PERMISSION_FILE'}
1375 || "/etc/permissions.d/dasscm.permission_backup";
[286]1376
[205]1377 # get command line options and store them in options hash
[214]1378 my $result = GetOptions( \%options, 'verbose', 'message=s' );
[205]1379
1380 # print options
1381 foreach my $option ( keys %options ) {
[215]1382 print "${option}: $options{$option}\n";
[205]1383 }
1384
[214]1385 # set verbose to command line option
1386 $verbose = $options{'verbose'};
1387
1388 #
1389 # action accordinly to command are taken
1390 # $command is rewritten in standard format,
1391 # so we can test for it later on more simply
1392 #
[205]1393 $_ = $command;
[274]1394 if (m/^help$/i) {
[205]1395 help(@ARGV);
[274]1396 } elsif (m/^login$/i) {
[208]1397 $command = "login";
[205]1398 login(@ARGV);
[274]1399 } elsif (m/^init$/i) {
[208]1400 $command = "init";
[205]1401 init(@ARGV);
[274]1402 } elsif (m/^ls$/i) {
[215]1403 $command = "ls";
1404 ls(@ARGV);
[274]1405 } elsif ( (m/^update$/i) || (m/^up$/i) ) {
[215]1406 $command = "update";
1407 update(@ARGV);
[274]1408 } elsif (m/^add$/i) {
[205]1409 $command = "add";
1410 add(@ARGV);
[274]1411 } elsif ( (m/^commit$/i) || (m/^checkin$/i) || (m/^ci$/i) ) {
[205]1412 $command = "commit";
[271]1413 commit(@ARGV);
[800]1414 } elsif (m/^revert$/i) {
1415 $command = "revert";
1416 $return_code = revert(@ARGV);
[274]1417 } elsif (m/^blame$/i) {
[208]1418 $command = "blame";
[205]1419 blame(@ARGV);
[274]1420 } elsif (m/^diff$/i) {
[208]1421 $command = "diff";
[205]1422 diff(@ARGV);
[274]1423 } elsif ( (m/^status$/i) || (m/^st$/i) ) {
[252]1424 $command = "status";
1425 $return_code = status(@ARGV);
[277]1426 } elsif (m/^check$/i) {
1427 $command = "check";
1428 $return_code = check();
[274]1429 } elsif (m/^permissions$/i) {
[290]1430 $command = "permissions";
[278]1431 $return_code = permissions();
[274]1432 } elsif (m/^cleanup$/i) {
1433 $command = "cleanup";
1434 cleanup();
[205]1435 } else {
[215]1436 print "unknown command: $command\n\n";
[205]1437 usage();
1438 check_env();
[252]1439 $return_code = $RETURN_NOK;
[205]1440 }
[186]1441}
[252]1442
1443exit $return_code;
Note: See TracBrowser for help on using the repository browser.