source: trunk/dasscm/dasscm@ 290

Last change on this file since 290 was 290, checked in by joergs, on Mar 11, 2009 at 7:51:54 AM

perltidy

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