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