src/commands/lock

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use Getopt::Long;
   6
   7 use lib $ENV{GL_LIBDIR};
   8 use Gitolite::Rc;
   9 use Gitolite::Common;
  10 use Gitolite::Conf::Load;
  11
  12 # gitolite command to lock and unlock (binary) files and deal with locks.
  13
  14 =for usage
  15 Usage:  ssh git@host lock -l      <repo> <file>     # lock a file
  16         ssh git@host lock -u      <repo> <file>     # unlock a file
  17         ssh git@host lock --break <repo> <file>     # break someone else's lock
  18         ssh git@host lock -ls     <repo>            # list locked files for repo
  19
  20 See doc/locking.mkd for other details.
  21 =cut
  22
  23 usage() if not @ARGV or $ARGV[0] eq '-h';
  24 $ENV{GL_USER} or _die "GL_USER not set";
  25
  26 my $op = '';
  27 $op = 'lock'   if $ARGV[0] eq '-l';
  28 $op = 'unlock' if $ARGV[0] eq '-u';
  29 $op = 'break'  if $ARGV[0] eq '--break';
  30 $op = 'list'   if $ARGV[0] eq '-ls';
  31 usage() if not $op;
  32 shift;
  33
  34 my $repo = shift;
  35 _die "You are not authorised" if access( $repo, $ENV{GL_USER}, 'W', 'any' ) =~ /DENIED/;
  36 _die "You are not authorised" if $op eq 'break' and access( $repo, $ENV{GL_USER}, '+', 'any' ) =~ /DENIED/;
  37
  38 my $file = shift || '';
  39 usage() if $op ne 'list' and not $file;
  40
  41 _chdir( $ENV{GL_REPO_BASE} );
  42 _chdir("$repo.git");
  43
  44 _die "aborting, file '$file' not found in any branch" if $file and not object_exists($file);
  45
  46 my $ff = "gl-locks";
  47
  48 if ( $op eq 'lock' ) {
  49     f_lock( $repo, $file );
  50 } elsif ( $op eq 'unlock' ) {
  51     f_unlock( $repo, $file );
  52 } elsif ( $op eq 'break' ) {
  53     f_break( $repo, $file );
  54 } elsif ( $op eq 'list' ) {
  55     f_list($repo);
  56 }
  57
  58 # ----------------------------------------------------------------------
  59 # For a given path, return 1 if object exists in any branch, 0 if not.
  60 # This is to prevent locking invalid objects.
  61
  62 sub object_exists {
  63     my $file = shift;
  64
  65     my @branches = `git for-each-ref refs/heads '--format=%(refname)'`;
  66     foreach my $b (@branches) {
  67         chomp($b);
  68         system("git cat-file -e $b:$file 2>/dev/null") or return 1;
  69         # note that with system(), the return value is "shell truth", so
  70         # you check for success with "or", not "and"
  71     }
  72     return 0;    # report object not found
  73 }
  74
  75 # ----------------------------------------------------------------------
  76 # everything below assumes we have already chdir'd to "$repo.git".  Also, $ff
  77 # is used as a global.
  78
  79 sub f_lock {
  80     my ( $repo, $file ) = @_;
  81
  82     my %locks = get_locks();
  83     _die "'$file' locked by '$locks{$file}{USER}' since " . localtime( $locks{$file}{TIME} ) if $locks{$file}{USER};
  84     $locks{$file}{USER} = $ENV{GL_USER};
  85     $locks{$file}{TIME} = time;
  86     put_locks(%locks);
  87 }
  88
  89 sub f_unlock {
  90     my ( $repo, $file ) = @_;
  91
  92     my %locks = get_locks();
  93     _die "'$file' not locked by '$ENV{GL_USER}'" if ( $locks{$file}{USER} || '' ) ne $ENV{GL_USER};
  94     delete $locks{$file};
  95     put_locks(%locks);
  96 }
  97
  98 sub f_break {
  99     my ( $repo, $file ) = @_;
 100
 101     my %locks = get_locks();
 102     _die "'$file' was not locked" unless $locks{$file};
 103     push @{ $locks{BREAKS} }, time . " $ENV{GL_USER} $locks{$file}{USER} $locks{$file}{TIME} $file";
 104     delete $locks{$file};
 105     put_locks(%locks);
 106 }
 107
 108 sub f_list {
 109     my $repo = shift;
 110
 111     my %locks = get_locks();
 112     print "\n# locks held:\n\n";
 113     map { print "$locks{$_}{USER}\t$_\t(" . scalar( localtime( $locks{$_}{TIME} ) ) . ")\n" } grep { $_ ne 'BREAKS' } sort keys %locks;
 114     print "\n# locks broken:\n\n";
 115     for my $b ( @{ $locks{BREAKS} } ) {
 116         my ( $when, $who, $whose, $how_old, $what ) = split ' ', $b;
 117         print "$who\t$what\t(" . scalar( localtime($when) ) . ")\t(locked by $whose at " . scalar( localtime($how_old) ) . ")\n";
 118     }
 119 }
 120
 121 sub get_locks {
 122     if ( -f $ff ) {
 123         our %locks;
 124
 125         my $t = slurp($ff);
 126         eval $t;
 127         _die "do '$ff' failed with '$@', contact your administrator" if $@;
 128
 129         return %locks;
 130     }
 131     return ();
 132 }
 133
 134 sub put_locks {
 135     my %locks = @_;
 136
 137     use Data::Dumper;
 138     $Data::Dumper::Indent   = 1;
 139     $Data::Dumper::Sortkeys = 1;
 140
 141     my $dumped_data = Data::Dumper->Dump( [ \%locks ], [qw(*locks)] );
 142     _print( $ff, $dumped_data );
 143 }