Girocco::Project: add infrastructure for getting/setting HEAD
[girocco/testingthisout.git] / Girocco / Project.pm
blob50bbb3233aefa957302945f71d6b5447ad5e6f6c
1 package Girocco::Project;
3 use strict;
4 use warnings;
6 BEGIN {
7 use Girocco::CGI;
8 use Girocco::User;
9 use Girocco::Util;
10 use Girocco::ProjPerm;
11 use Girocco::Config;
12 use base ('Girocco::ProjPerm::'.$Girocco::Config::permission_control); # mwahaha
15 our $metadata_fields = {
16 homepage => ['Homepage URL', 'hp', 'text'],
17 shortdesc => ['Short description', 'desc', 'text'],
18 README => ['README (HTML, lt 8kb)', 'README', 'textarea'],
19 notifymail => ['Commit notify - mail to', 'notifymail', 'text'],
20 notifyjson => ['Commit notify - <a href="http://help.github.com/post-receive-hooks/">POST JSON</a> at', 'notifyjson', 'text'],
21 notifycia => ['Commit notify - <a href="http://cia.vc/doc/">CIA project</a> name', 'notifycia', 'text'],
24 sub _mkdir_forkees {
25 my $self = shift;
26 my @pelems = split('/', $self->{name});
27 pop @pelems; # do not create dir for the project itself
28 my $path = $self->{base_path};
29 foreach my $pelem (@pelems) {
30 $path .= "/$pelem";
31 (-d "$path") or mkdir $path or die "mkdir $path: $!";
32 chmod 0775, $path; # ok if fails (dir may already exist and be owned by someone else)
36 our %propmap = (
37 url => ':baseurl',
38 email => ':owner',
39 desc => 'description',
40 README => 'README.html',
41 hp => ':homepage',
42 notifymail => '%hooks.mailinglist',
43 notifyjson => '%hooks.jsonurl',
44 notifycia => '%hooks.cianame',
47 sub _property_path {
48 my $self = shift;
49 my ($name) = @_;
50 $self->{path}.'/'.$name;
53 sub _property_fget {
54 my $self = shift;
55 my ($name) = @_;
56 my $pname = $propmap{$name};
57 $pname or die "unknown property: $name";
58 if ($pname =~ s/^://) {
59 my $val = `git --git-dir="$self->{path}" config "gitweb.$pname"`;
60 chomp $val;
61 return $val;
62 } elsif ($pname =~ s/^%//) {
63 my $val = `git --git-dir="$self->{path}" config "$pname"`;
64 chomp $val;
65 return $val;
68 open P, $self->_property_path($pname) or return undef;
69 my @value = <P>;
70 close P;
71 my $value = join('', @value); chomp $value;
72 $value;
75 sub _property_fput {
76 my $self = shift;
77 my ($name, $value) = @_;
78 my $pname = $propmap{$name};
79 $pname or die "unknown property: $name";
80 $value ||= '';
81 if ($pname =~ s/^://) {
82 system('git', '--git-dir='.$self->{path}, 'config', "gitweb.$pname", $value);
83 return;
84 } elsif ($pname =~ s/^%//) {
85 system('git', '--git-dir='.$self->{path}, 'config', $pname, $value);
86 return;
89 my $P = lock_file($self->_property_path($pname));
90 $value ne '' and print $P "$value\n";
91 close $P;
92 unlock_file($self->_property_path($pname));
95 sub _properties_load {
96 my $self = shift;
97 foreach my $prop (keys %propmap) {
98 $self->{$prop} = $self->_property_fget($prop);
102 sub _properties_save {
103 my $self = shift;
104 foreach my $prop (keys %propmap) {
105 $self->_property_fput($prop, $self->{$prop});
109 sub _nofetch_path {
110 my $self = shift;
111 $self->_property_path('.nofetch');
114 sub _nofetch {
115 my $self = shift;
116 my ($nofetch) = @_;
117 my $np = $self->_nofetch_path;
118 if ($nofetch) {
119 open X, '>'.$np or die "nofetch failed: $!";
120 close X;
121 } else {
122 unlink $np or die "yesfetch failed: $!";
126 sub _clonelog_path {
127 my $self = shift;
128 $self->_property_path('.clonelog');
131 sub _clonefail_path {
132 my $self = shift;
133 $self->_property_path('.clone_failed');
136 sub _clonep_path {
137 my $self = shift;
138 $self->_property_path('.clone_in_progress');
141 sub _clonep {
142 my $self = shift;
143 my ($nofetch) = @_;
144 my $np = $self->_clonep_path;
145 if ($nofetch) {
146 open X, '>'.$np or die "clonep failed: $!";
147 close X;
148 } else {
149 unlink $np or die "clonef failed: $!";
152 sub _alternates_setup {
153 my $self = shift;
154 return unless $self->{name} =~ m#/#;
155 my $forkee_name = get_forkee_name($self->{name});
156 my $forkee_path = get_forkee_path($self->{name});
157 return unless -d $forkee_path;
158 mkdir $self->{path}.'/refs'; chmod 0775, $self->{path}.'/refs';
159 mkdir $self->{path}.'/objects'; chmod 0775, $self->{path}.'/objects';
160 mkdir $self->{path}.'/objects/info'; chmod 0775, $self->{path}.'/objects/info';
162 # We set up both alternates and http_alternates since we cannot use
163 # relative path in alternates - that doesn't work recursively.
165 my $filename = $self->{path}.'/objects/info/alternates';
166 open X, '>'.$filename or die "alternates failed: $!";
167 print X "$forkee_path/objects\n";
168 close X;
169 chmod 0664, $filename or warn "cannot chmod $filename: $!";
171 if ($Girocco::Config::httppullurl) {
172 $filename = $self->{path}.'/objects/info/http-alternates';
173 open X, '>'.$filename or die "http-alternates failed: $!";
174 my $upfork = $forkee_name;
175 do { print X "$Girocco::Config::httppullurl/$upfork.git/objects\n"; } while ($upfork =~ s#/?.+?$## and $upfork); #
176 close X;
177 chmod 0664, $filename or warn "cannot chmod $filename: $!";
180 # The symlink is problematic since git remote prune will traverse it.
181 #symlink "$forkee_path/refs", $self->{path}.'/refs/forkee';
183 # copy refs from parent project
184 system("$Girocco::Config::git_bin --git-dir=$forkee_path show-ref > $self->{path}/packed-refs");
185 # initialize HEAD, hacky version
186 system("cp $forkee_path/HEAD $self->{path}/HEAD");
189 sub _ctags_setup {
190 my $self = shift;
191 mkdir $self->{path}.'/ctags'; chmod 01777, $self->{path}.'/ctags';
194 sub _group_add {
195 my $self = shift;
196 my ($xtra) = @_;
197 $xtra .= join(',', @{$self->{users}});
198 filedb_atomic_append(jailed_file('/etc/group'),
199 join(':', $self->{name}, $self->{crypt}, '\i', $xtra));
202 sub _group_update {
203 my $self = shift;
204 my $xtra = join(',', @{$self->{users}});
205 filedb_atomic_edit(jailed_file('/etc/group'),
206 sub {
207 $_ = $_[0];
208 chomp;
209 if ($self->{name} eq (split /:/)[0]) {
210 # preserve readonly flag
211 s/::([^:]*)$/:$1/ and $xtra = ":$xtra";
212 return join(':', $self->{name}, $self->{crypt}, $self->{gid}, $xtra)."\n";
213 } else {
214 return "$_\n";
220 sub _group_remove {
221 my $self = shift;
222 filedb_atomic_edit(jailed_file('/etc/group'),
223 sub {
224 $self->{name} ne (split /:/)[0] and return $_;
229 sub _hook_path {
230 my $self = shift;
231 my ($name) = @_;
232 $self->{path}.'/hooks/'.$name;
235 sub _hook_install {
236 my $self = shift;
237 my ($name) = @_;
238 open SRC, "$Girocco::Config::basedir/hooks/$name" or die "cannot open hook $name: $!";
239 open DST, '>'.$self->_hook_path($name) or die "cannot open hook $name for writing: $!";
240 while (<SRC>) { print DST $_; }
241 close DST;
242 close SRC;
243 chmod 0775, $self->_hook_path($name) or die "cannot chmod hook $name: $!";
246 sub _hooks_install {
247 my $self = shift;
248 foreach my $hook ('post-receive', 'update', 'post-update') {
249 $self->_hook_install($hook);
253 # private constructor, do not use
254 sub _new {
255 my $class = shift;
256 my ($name, $base_path, $path) = @_;
257 valid_name($name) or die "refusing to create project with invalid name ($name)!";
258 $path ||= "$base_path/$name.git";
259 my $proj = { name => $name, base_path => $base_path, path => $path };
261 bless $proj, $class;
264 # public constructor #0
265 # creates a virtual project not connected to disk image
266 # you can conjure() it later to disk
267 sub ghost {
268 my $class = shift;
269 my ($name, $mirror) = @_;
270 my $self = $class->_new($name, $Girocco::Config::reporoot);
271 $self->{users} = [];
272 $self->{mirror} = $mirror;
273 $self;
276 # public constructor #1
277 sub load {
278 my $class = shift;
279 my ($name) = @_;
281 open F, jailed_file("/etc/group") or die "project load failed: $!";
282 while (<F>) {
283 chomp;
284 @_ = split /:+/;
285 next unless (shift eq $name);
287 my $self = $class->_new($name, $Girocco::Config::reporoot);
288 (-d $self->{path}) or die "invalid path (".$self->{path}.") for project ".$self->{name};
290 my $ulist;
291 ($self->{crypt}, $self->{gid}, $ulist) = @_;
292 $ulist ||= '';
293 $self->{users} = [split /,/, $ulist];
294 $self->{HEAD} = $self->get_HEAD;
295 $self->{orig_HEAD} = $self->{HEAD};
296 $self->{orig_users} = [@{$self->{users}}];
297 $self->{mirror} = ! -e $self->_nofetch_path;
298 $self->{clone_in_progress} = -e $self->_clonep_path;
299 $self->{clone_logged} = -e $self->_clonelog_path;
300 $self->{clone_failed} = -e $self->_clonefail_path;
301 $self->{ccrypt} = $self->{crypt};
303 $self->_properties_load;
304 return $self;
306 close F;
307 undef;
310 # $proj may not be in sane state if this returns false!
311 sub cgi_fill {
312 my $self = shift;
313 my ($gcgi) = @_;
314 my $cgi = $gcgi->cgi;
316 my ($pwd, $pwd2) = ($cgi->param('pwd'), $cgi->param('pwd2'));
317 $pwd ||= ''; $pwd2 ||= ''; # in case passwords are disabled
318 if ($pwd or not $self->{crypt}) {
319 $self->{crypt} = scrypt($pwd);
322 if ($pwd2 and $pwd ne $pwd2) {
323 $gcgi->err("Our high-paid security consultants have determined that the admin passwords you have entered do not match each other.");
326 $self->{cpwd} = $cgi->param('cpwd');
328 if ($Girocco::Config::project_owners eq 'email') {
329 $self->{email} = $gcgi->wparam('email');
330 valid_email($self->{email})
331 or $gcgi->err("Your email sure looks weird...?");
334 $self->{url} = $gcgi->wparam('url');
335 if ($self->{url}) {
336 valid_repo_url($self->{url})
337 or $gcgi->err("Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me.");
340 $self->{desc} = $gcgi->wparam('desc');
341 length($self->{desc}) <= 1024
342 or $gcgi->err("<b>Short</b> description length &gt; 1kb!");
344 $self->{README} = $gcgi->wparam('README');
345 length($self->{README}) <= 8192
346 or $gcgi->err("README length &gt; 8kb!");
348 $self->{hp} = $gcgi->wparam('hp');
349 if ($self->{hp}) {
350 valid_web_url($self->{hp})
351 or $gcgi->err("Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
354 $self->{users} = [grep { Girocco::User::valid_name($_) && Girocco::User::does_exist($_) } $cgi->param('user')];
356 $self->{HEAD} = $cgi->param('HEAD') if $cgi->param('HEAD');
358 $self->{notifymail} = $gcgi->wparam('notifymail');
359 if ($self->{notifymail}) {
360 (valid_email_multi($self->{notifymail}) and length($self->{notifymail}) <= 512)
361 or $gcgi->err("Invalid notify e-mail address. Use mail,mail to specify multiple addresses; total length must not exceed 512 characters, however.");
364 $self->{notifyjson} = $gcgi->wparam('notifyjson');
365 if ($self->{notifyjson}) {
366 valid_web_url($self->{notifyjson})
367 or $gcgi->err("Invalid JSON notify URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
370 $self->{notifycia} = $gcgi->wparam('notifycia');
371 if ($self->{notifycia}) {
372 $self->{notifycia} =~ /^[a-zA-Z0-9._-]+$/
373 or $gcgi->err("Overly suspicious CIA notify project name. If it is actually valid, contact me.");
376 not $gcgi->err_check;
379 sub form_defaults {
380 my $self = shift;
382 name => $self->{name},
383 email => $self->{email},
384 url => $self->{url},
385 desc => html_esc($self->{desc}),
386 README => html_esc($self->{README}),
387 hp => $self->{hp},
388 users => $self->{users},
389 notifymail => html_esc($self->{notifymail}),
390 notifyjson => html_esc($self->{notifyjson}),
391 notifycia => html_esc($self->{notifycia}),
395 sub authenticate {
396 my $self = shift;
397 my ($gcgi) = @_;
399 $self->{ccrypt} or die "Can't authenticate against a project with no password";
400 $self->{cpwd} ||= '';
401 unless ($self->{ccrypt} eq crypt($self->{cpwd}, $self->{ccrypt})) {
402 $gcgi->err("Your admin password does not match!");
403 return 0;
405 return 1;
408 sub _setup {
409 my $self = shift;
410 my ($pushers) = @_;
412 $self->_mkdir_forkees;
414 mkdir($self->{path}) or die "mkdir $self->{path} failed: $!";
415 if ($Girocco::Config::owning_group) {
416 my $gid = scalar(getgrnam($Girocco::Config::owning_group));
417 chown(-1, $gid, $self->{path}) or die "chgrp $gid $self->{path} failed: $!";
418 chmod(02775, $self->{path}) or die "chmod 2775 $self->{path} failed: $!";
419 } else {
420 chmod(02777, $self->{path}) or die "chmod 2777 $self->{path} failed: $!";
422 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'init', '--bare', '--shared='.$self->shared_mode()) == 0
423 or die "git init $self->{path} failed: $?";
424 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'receive.denyNonFastforwards', 'false') == 0
425 or die "disabling receive.denyNonFastforwards failed: $?";
426 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'gc.auto', '0') == 0
427 or die "disabling gc.auto failed: $?";
429 # /info must have right permissions even before the fixup job,
430 # and git init didn't do it for some reason.
431 if ($Girocco::Config::owning_group) {
432 chmod(02775, $self->{path}."/info") or die "chmod 2775 $self->{path}/info failed: $!";
433 } else {
434 chmod(02777, $self->{path}."/info") or die "chmod 2777 $self->{path}/info failed: $!";
437 $self->_properties_save;
438 $self->_alternates_setup;
439 $self->_ctags_setup;
440 $self->_group_add($pushers);
441 $self->_hooks_install;
442 $self->perm_initialize;
443 system($Girocco::Config::basedir . '/gitweb/genindex.sh');
446 sub premirror {
447 my $self = shift;
449 $self->_setup(':');
450 $self->_clonep(1);
453 sub conjure {
454 my $self = shift;
456 $self->_setup;
457 $self->_nofetch(1);
460 sub clone {
461 my $self = shift;
463 unlink ($self->_clonefail_path()); # Ignore EEXIST error
464 unlink ($self->_clonelog_path()); # Ignore EEXIST error
466 use IO::Socket;
467 my $sock = IO::Socket::UNIX->new($Girocco::Config::chroot.'/etc/taskd.socket') or die "cannot connect to taskd.socket: $!";
468 $sock->print("clone ".$self->{name}."\n");
469 # Just ignore reply, we are going to succeed anyway and the I/O
470 # would apparently get quite hairy.
471 $sock->flush();
472 sleep 2; # *cough*
473 $sock->close();
476 sub update {
477 my $self = shift;
479 $self->_properties_save;
480 $self->_group_update;
482 $self->set_HEAD($self->{HEAD}) unless $self->{orig_HEAD} eq $self->{HEAD};
484 my @users_add = grep { $a = $_; not scalar grep { $a eq $_ } $self->{orig_users} } $self->{users};
485 my @users_del = grep { $a = $_; not scalar grep { $a eq $_ } $self->{users} } $self->{orig_users};
486 $self->perm_user_add($_, Girocco::User::resolve_uid($_)) foreach (@users_add);
487 $self->perm_user_del($_, Girocco::User::resolve_uid($_)) foreach (@users_del);
492 sub update_password {
493 my $self = shift;
494 my ($pwd) = @_;
496 $self->{crypt} = scrypt($pwd);
497 $self->_group_update;
500 # You can explicitly do this just on a ghost() repository too.
501 sub delete {
502 my $self = shift;
504 if (-d $self->{path}) {
505 system('rm', '-rf', $self->{path}) == 0
506 or die "rm -rf $self->{path} failed: $?";
508 $self->_group_remove;
511 sub has_forks {
512 my $self = shift;
514 return glob($Girocco::Config::reporoot.'/'.$self->{name}.'/*');
517 sub get_heads {
518 my $self = shift;
519 my $fh;
520 open($fh, '-|', "$Girocco::Config::git_bin --git-dir=$self->{path} show-ref --heads") or die "could not get list of heads";
521 my @res;
522 while (<$fh>) {
523 chomp;
524 next if !m#^[0-9a-f]{40}\s+refs/heads/(.*)+$ #x;
525 push @res, $1;
527 close $fh;
528 @res;
531 sub get_HEAD {
532 my $self = shift;
533 my $HEAD = `$Girocco::Config::git_bin --git-dir=$self->{path} symbolic-ref HEAD`;
534 chomp $HEAD;
535 die "could not get HEAD" if ($HEAD !~ m{^refs/heads/(.+)$});
536 return $1;
539 sub set_HEAD {
540 my $self = shift;
541 my $newHEAD = shift;
542 # Cursory checks only -- if you want to break your HEAD, be my guest
543 if ($newHEAD =~ /^\/|['<>]|\.\.|\/$/) {
544 die "grossly invalid new HEAD: $newHEAD";
546 system("$Girocco::Config::git_bin --git-dir=$self->{path} symbolic-ref HEAD 'refs/heads/$newHEAD'") or die "could not set HEAD";
549 ### static methods
551 sub get_forkee_name {
552 $_ = $_[0];
553 (m#^(.*)/.*?$#)[0]; #
555 sub get_forkee_path {
556 my $forkee = $Girocco::Config::reporoot.'/'.get_forkee_name($_[0]).'.git';
557 -d $forkee ? $forkee : '';
560 sub valid_name {
561 $_ = $_[0];
562 (not m#/# or -d get_forkee_path($_)) # will also catch ^/
563 and (not m#\./#)
564 and (not m#/$#)
565 and m#^[a-zA-Z0-9+./_-]+$#;
568 sub does_exist {
569 my ($name) = @_;
570 valid_name($name) or die "tried to query for project with invalid name $name!";
571 (-d $Girocco::Config::reporoot."/$name.git");
574 sub get_full_list {
575 my $class = shift;
576 my @projects;
578 open F, jailed_file("/etc/group") or die "getting project list failed: $!";
579 while (<F>) {
580 chomp;
581 @_ = split /:+/;
582 next if ($_[2] < 65536);
584 push @projects, $_[0];
586 close F;
587 @projects;