install: mkfifo only if the file is not fifo yet
[girocco.git] / Girocco / Project.pm
blob34693e1b8009634000d9a2e266717bcc4b744377
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 # ownership information is changed by a root cronjob
185 system("cp -a $forkee_path/refs $self->{path}/");
186 # initialize HEAD, hacky version
187 system("cp $forkee_path/HEAD $self->{path}/HEAD");
190 sub _ctags_setup {
191 my $self = shift;
192 mkdir $self->{path}.'/ctags'; chmod 01777, $self->{path}.'/ctags';
195 sub _group_add {
196 my $self = shift;
197 my ($xtra) = @_;
198 $xtra .= join(',', @{$self->{users}});
199 filedb_atomic_append(jailed_file('/etc/group'),
200 join(':', $self->{name}, $self->{crypt}, '\i', $xtra));
203 sub _group_update {
204 my $self = shift;
205 my $xtra = join(',', @{$self->{users}});
206 filedb_atomic_edit(jailed_file('/etc/group'),
207 sub {
208 $_ = $_[0];
209 chomp;
210 if ($self->{name} eq (split /:/)[0]) {
211 # preserve readonly flag
212 s/::([^:]*)$/:$1/ and $xtra = ":$xtra";
213 return join(':', $self->{name}, $self->{crypt}, $self->{gid}, $xtra)."\n";
214 } else {
215 return "$_\n";
221 sub _group_remove {
222 my $self = shift;
223 filedb_atomic_edit(jailed_file('/etc/group'),
224 sub {
225 $self->{name} ne (split /:/)[0] and return $_;
230 sub _hook_path {
231 my $self = shift;
232 my ($name) = @_;
233 $self->{path}.'/hooks/'.$name;
236 sub _hook_install {
237 my $self = shift;
238 my ($name) = @_;
239 open SRC, "$Girocco::Config::basedir/hooks/$name" or die "cannot open hook $name: $!";
240 open DST, '>'.$self->_hook_path($name) or die "cannot open hook $name for writing: $!";
241 while (<SRC>) { print DST $_; }
242 close DST;
243 close SRC;
244 chmod 0775, $self->_hook_path($name) or die "cannot chmod hook $name: $!";
247 sub _hooks_install {
248 my $self = shift;
249 foreach my $hook ('post-receive', 'update', 'post-update') {
250 $self->_hook_install($hook);
254 # private constructor, do not use
255 sub _new {
256 my $class = shift;
257 my ($name, $base_path, $path) = @_;
258 valid_name($name) or die "refusing to create project with invalid name ($name)!";
259 $path ||= "$base_path/$name.git";
260 my $proj = { name => $name, base_path => $base_path, path => $path };
262 bless $proj, $class;
265 # public constructor #0
266 # creates a virtual project not connected to disk image
267 # you can conjure() it later to disk
268 sub ghost {
269 my $class = shift;
270 my ($name, $mirror) = @_;
271 my $self = $class->_new($name, $Girocco::Config::reporoot);
272 $self->{users} = [];
273 $self->{mirror} = $mirror;
274 $self;
277 # public constructor #1
278 sub load {
279 my $class = shift;
280 my ($name) = @_;
282 open F, jailed_file("/etc/group") or die "project load failed: $!";
283 while (<F>) {
284 chomp;
285 @_ = split /:+/;
286 next unless (shift eq $name);
288 my $self = $class->_new($name, $Girocco::Config::reporoot);
289 (-d $self->{path}) or die "invalid path (".$self->{path}.") for project ".$self->{name};
291 my $ulist;
292 ($self->{crypt}, $self->{gid}, $ulist) = @_;
293 $ulist ||= '';
294 $self->{users} = [split /,/, $ulist];
295 $self->{HEAD} = $self->get_HEAD;
296 $self->{orig_HEAD} = $self->{HEAD};
297 $self->{orig_users} = [@{$self->{users}}];
298 $self->{mirror} = ! -e $self->_nofetch_path;
299 $self->{clone_in_progress} = -e $self->_clonep_path;
300 $self->{clone_logged} = -e $self->_clonelog_path;
301 $self->{clone_failed} = -e $self->_clonefail_path;
302 $self->{ccrypt} = $self->{crypt};
304 $self->_properties_load;
305 return $self;
307 close F;
308 undef;
311 # $proj may not be in sane state if this returns false!
312 sub cgi_fill {
313 my $self = shift;
314 my ($gcgi) = @_;
315 my $cgi = $gcgi->cgi;
317 my ($pwd, $pwd2) = ($cgi->param('pwd'), $cgi->param('pwd2'));
318 $pwd ||= ''; $pwd2 ||= ''; # in case passwords are disabled
319 if ($pwd or not $self->{crypt}) {
320 $self->{crypt} = scrypt($pwd);
323 if ($pwd2 and $pwd ne $pwd2) {
324 $gcgi->err("Our high-paid security consultants have determined that the admin passwords you have entered do not match each other.");
327 $self->{cpwd} = $cgi->param('cpwd');
329 if ($Girocco::Config::project_owners eq 'email') {
330 $self->{email} = $gcgi->wparam('email');
331 valid_email($self->{email})
332 or $gcgi->err("Your email sure looks weird...?");
335 $self->{url} = $gcgi->wparam('url');
336 if ($self->{url}) {
337 valid_repo_url($self->{url})
338 or $gcgi->err("Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me.");
341 $self->{desc} = $gcgi->wparam('desc');
342 length($self->{desc}) <= 1024
343 or $gcgi->err("<b>Short</b> description length &gt; 1kb!");
345 $self->{README} = $gcgi->wparam('README');
346 length($self->{README}) <= 8192
347 or $gcgi->err("README length &gt; 8kb!");
349 $self->{hp} = $gcgi->wparam('hp');
350 if ($self->{hp}) {
351 valid_web_url($self->{hp})
352 or $gcgi->err("Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
355 $self->{users} = [grep { Girocco::User::valid_name($_) && Girocco::User::does_exist($_) } $cgi->param('user')];
357 $self->{HEAD} = $cgi->param('HEAD') if $cgi->param('HEAD');
359 # schedule deletion of tags (will be committed by update() after auth)
360 $self->{tags_to_delete} = [$cgi->param('tags')];
362 $self->{notifymail} = $gcgi->wparam('notifymail');
363 if ($self->{notifymail}) {
364 (valid_email_multi($self->{notifymail}) and length($self->{notifymail}) <= 512)
365 or $gcgi->err("Invalid notify e-mail address. Use mail,mail to specify multiple addresses; total length must not exceed 512 characters, however.");
368 $self->{notifyjson} = $gcgi->wparam('notifyjson');
369 if ($self->{notifyjson}) {
370 valid_web_url($self->{notifyjson})
371 or $gcgi->err("Invalid JSON notify URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
374 $self->{notifycia} = $gcgi->wparam('notifycia');
375 if ($self->{notifycia}) {
376 $self->{notifycia} =~ /^[a-zA-Z0-9._-]+$/
377 or $gcgi->err("Overly suspicious CIA notify project name. If it is actually valid, contact me.");
380 not $gcgi->err_check;
383 sub form_defaults {
384 my $self = shift;
386 name => $self->{name},
387 email => $self->{email},
388 url => $self->{url},
389 desc => html_esc($self->{desc}),
390 README => html_esc($self->{README}),
391 hp => $self->{hp},
392 users => $self->{users},
393 notifymail => html_esc($self->{notifymail}),
394 notifyjson => html_esc($self->{notifyjson}),
395 notifycia => html_esc($self->{notifycia}),
399 sub authenticate {
400 my $self = shift;
401 my ($gcgi) = @_;
403 $self->{ccrypt} or die "Can't authenticate against a project with no password";
404 $self->{cpwd} ||= '';
405 unless ($self->{ccrypt} eq crypt($self->{cpwd}, $self->{ccrypt})) {
406 $gcgi->err("Your admin password does not match!");
407 return 0;
409 return 1;
412 sub _setup {
413 my $self = shift;
414 my ($pushers) = @_;
416 $self->_mkdir_forkees;
418 mkdir($self->{path}) or die "mkdir $self->{path} failed: $!";
419 if ($Girocco::Config::owning_group) {
420 my $gid = scalar(getgrnam($Girocco::Config::owning_group));
421 chown(-1, $gid, $self->{path}) or die "chgrp $gid $self->{path} failed: $!";
422 chmod(02775, $self->{path}) or die "chmod 2775 $self->{path} failed: $!";
423 } else {
424 chmod(02777, $self->{path}) or die "chmod 2777 $self->{path} failed: $!";
426 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'init', '--bare', '--shared='.$self->shared_mode()) == 0
427 or die "git init $self->{path} failed: $?";
428 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'receive.denyNonFastforwards', 'false') == 0
429 or die "disabling receive.denyNonFastforwards failed: $?";
430 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'gc.auto', '0') == 0
431 or die "disabling gc.auto failed: $?";
433 # /info must have right permissions even before the fixup job,
434 # and git init didn't do it for some reason.
435 if ($Girocco::Config::owning_group) {
436 chmod(02775, $self->{path}."/info") or die "chmod 2775 $self->{path}/info failed: $!";
437 } else {
438 chmod(02777, $self->{path}."/info") or die "chmod 2777 $self->{path}/info failed: $!";
441 $self->_properties_save;
442 $self->_alternates_setup;
443 $self->_ctags_setup;
444 $self->_group_add($pushers);
445 $self->_hooks_install;
446 $self->perm_initialize;
447 system($Girocco::Config::basedir . '/gitweb/genindex.sh');
450 sub premirror {
451 my $self = shift;
453 $self->_setup(':');
454 $self->_clonep(1);
457 sub conjure {
458 my $self = shift;
460 $self->_setup;
461 $self->_nofetch(1);
464 sub clone {
465 my $self = shift;
467 unlink ($self->_clonefail_path()); # Ignore EEXIST error
468 unlink ($self->_clonelog_path()); # Ignore EEXIST error
470 use IO::Socket;
471 my $sock = IO::Socket::UNIX->new($Girocco::Config::chroot.'/etc/taskd.socket') or die "cannot connect to taskd.socket: $!";
472 $sock->print("clone ".$self->{name}."\n");
473 # Just ignore reply, we are going to succeed anyway and the I/O
474 # would apparently get quite hairy.
475 $sock->flush();
476 sleep 2; # *cough*
477 $sock->close();
480 sub update {
481 my $self = shift;
483 $self->_properties_save;
484 $self->_group_update;
486 if (exists($self->{tags_to_delete})) {
487 $self->delete_ctag($_) foreach(@{$self->{tags_to_delete}});
490 $self->set_HEAD($self->{HEAD}) unless $self->{orig_HEAD} eq $self->{HEAD};
492 my @users_add = grep { $a = $_; not scalar grep { $a eq $_ } $self->{orig_users} } $self->{users};
493 my @users_del = grep { $a = $_; not scalar grep { $a eq $_ } $self->{users} } $self->{orig_users};
494 $self->perm_user_add($_, Girocco::User::resolve_uid($_)) foreach (@users_add);
495 $self->perm_user_del($_, Girocco::User::resolve_uid($_)) foreach (@users_del);
500 sub update_password {
501 my $self = shift;
502 my ($pwd) = @_;
504 $self->{crypt} = scrypt($pwd);
505 $self->_group_update;
508 # You can explicitly do this just on a ghost() repository too.
509 sub delete {
510 my $self = shift;
512 if (-d $self->{path}) {
513 system('rm', '-rf', $self->{path}) == 0
514 or die "rm -rf $self->{path} failed: $?";
516 $self->_group_remove;
519 sub has_forks {
520 my $self = shift;
522 return glob($Girocco::Config::reporoot.'/'.$self->{name}.'/*');
525 sub delete_ctag {
526 my $self = shift;
527 my ($ctag) = @_;
529 # sanity check, disallow filenames starting with . .. or /
530 unlink($self->{path}.'/ctags/'.$ctag) if($ctag !~ m|^(\.\.?)/|);
533 sub get_ctag_names {
534 my $self = shift;
535 my @ctags = ();
536 opendir(my $dh, $self->{path}.'/ctags')
537 or return @ctags;
538 @ctags = grep { -f "$self->{path}/ctags/$_" } readdir($dh);
539 closedir($dh);
540 return @ctags;
543 sub get_heads {
544 my $self = shift;
545 my $fh;
546 open($fh, '-|', "$Girocco::Config::git_bin --git-dir=$self->{path} show-ref --heads") or die "could not get list of heads";
547 my @res;
548 while (<$fh>) {
549 chomp;
550 next if !m#^[0-9a-f]{40}\s+refs/heads/(.+)$ #x;
551 push @res, $1;
553 close $fh;
554 @res;
557 sub get_HEAD {
558 my $self = shift;
559 my $HEAD = `$Girocco::Config::git_bin --git-dir=$self->{path} symbolic-ref HEAD`;
560 chomp $HEAD;
561 die "could not get HEAD" if ($HEAD !~ m{^refs/heads/(.+)$});
562 return $1;
565 sub set_HEAD {
566 my $self = shift;
567 my $newHEAD = shift;
568 # Cursory checks only -- if you want to break your HEAD, be my guest
569 if ($newHEAD =~ /^\/|['<>]|\.\.|\/$/) {
570 die "grossly invalid new HEAD: $newHEAD";
572 system($Girocco::Config::git_bin, "--git-dir=$self->{path}", 'symbolic-ref', 'HEAD', "refs/heads/$newHEAD");
573 die "could not set HEAD" if ($? >> 8);
576 ### static methods
578 sub get_forkee_name {
579 $_ = $_[0];
580 (m#^(.*)/.*?$#)[0]; #
582 sub get_forkee_path {
583 my $forkee = $Girocco::Config::reporoot.'/'.get_forkee_name($_[0]).'.git';
584 -d $forkee ? $forkee : '';
587 sub valid_name {
588 $_ = $_[0];
589 (not m#/# or -d get_forkee_path($_)) # will also catch ^/
590 and (not m#\./#)
591 and (not m#/$#)
592 and m#^[a-zA-Z0-9+./_-]+$#;
595 sub does_exist {
596 my ($name) = @_;
597 valid_name($name) or die "tried to query for project with invalid name $name!";
598 (-d $Girocco::Config::reporoot."/$name.git");
601 sub get_full_list {
602 my $class = shift;
603 my @projects;
605 open F, jailed_file("/etc/group") or die "getting project list failed: $!";
606 while (<F>) {
607 chomp;
608 @_ = split /:+/;
609 next if ($_[2] < 65536);
611 push @projects, $_[0];
613 close F;
614 @projects;