taskd/clone.sh: avoid unnecessary escape in darcs:// -> http:// mapping
[girocco/test-forks.git] / Girocco / Project.pm
blobe0099481d3aea9799e7dfccd2cbe330f7e733370
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';
184 sub _ctags_setup {
185 my $self = shift;
186 mkdir $self->{path}.'/ctags'; chmod 01777, $self->{path}.'/ctags';
189 sub _group_add {
190 my $self = shift;
191 my ($xtra) = @_;
192 $xtra .= join(',', @{$self->{users}});
193 filedb_atomic_append(jailed_file('/etc/group'),
194 join(':', $self->{name}, $self->{crypt}, '\i', $xtra));
197 sub _group_update {
198 my $self = shift;
199 my $xtra = join(',', @{$self->{users}});
200 filedb_atomic_edit(jailed_file('/etc/group'),
201 sub {
202 $_ = $_[0];
203 chomp;
204 if ($self->{name} eq (split /:/)[0]) {
205 # preserve readonly flag
206 s/::([^:]*)$/:$1/ and $xtra = ":$xtra";
207 return join(':', $self->{name}, $self->{crypt}, $self->{gid}, $xtra)."\n";
208 } else {
209 return "$_\n";
215 sub _group_remove {
216 my $self = shift;
217 filedb_atomic_edit(jailed_file('/etc/group'),
218 sub {
219 $self->{name} ne (split /:/)[0] and return $_;
224 sub _hook_path {
225 my $self = shift;
226 my ($name) = @_;
227 $self->{path}.'/hooks/'.$name;
230 sub _hook_install {
231 my $self = shift;
232 my ($name) = @_;
233 open SRC, "$Girocco::Config::basedir/hooks/$name" or die "cannot open hook $name: $!";
234 open DST, '>'.$self->_hook_path($name) or die "cannot open hook $name for writing: $!";
235 while (<SRC>) { print DST $_; }
236 close DST;
237 close SRC;
238 chmod 0775, $self->_hook_path($name) or die "cannot chmod hook $name: $!";
241 sub _hooks_install {
242 my $self = shift;
243 foreach my $hook ('post-receive', 'update', 'post-update') {
244 $self->_hook_install($hook);
248 # private constructor, do not use
249 sub _new {
250 my $class = shift;
251 my ($name, $base_path, $path) = @_;
252 valid_name($name) or die "refusing to create project with invalid name ($name)!";
253 $path ||= "$base_path/$name.git";
254 my $proj = { name => $name, base_path => $base_path, path => $path };
256 bless $proj, $class;
259 # public constructor #0
260 # creates a virtual project not connected to disk image
261 # you can conjure() it later to disk
262 sub ghost {
263 my $class = shift;
264 my ($name, $mirror) = @_;
265 my $self = $class->_new($name, $Girocco::Config::reporoot);
266 $self->{users} = [];
267 $self->{mirror} = $mirror;
268 $self;
271 # public constructor #1
272 sub load {
273 my $class = shift;
274 my ($name) = @_;
276 open F, jailed_file("/etc/group") or die "project load failed: $!";
277 while (<F>) {
278 chomp;
279 @_ = split /:+/;
280 next unless (shift eq $name);
282 my $self = $class->_new($name, $Girocco::Config::reporoot);
283 (-d $self->{path}) or die "invalid path (".$self->{path}.") for project ".$self->{name};
285 my $ulist;
286 ($self->{crypt}, $self->{gid}, $ulist) = @_;
287 $ulist ||= '';
288 $self->{users} = [split /,/, $ulist];
289 $self->{orig_users} = [@{$self->{users}}];
290 $self->{mirror} = ! -e $self->_nofetch_path;
291 $self->{clone_in_progress} = -e $self->_clonep_path;
292 $self->{clone_logged} = -e $self->_clonelog_path;
293 $self->{clone_failed} = -e $self->_clonefail_path;
294 $self->{ccrypt} = $self->{crypt};
296 $self->_properties_load;
297 return $self;
299 close F;
300 undef;
303 # $proj may not be in sane state if this returns false!
304 sub cgi_fill {
305 my $self = shift;
306 my ($gcgi) = @_;
307 my $cgi = $gcgi->cgi;
309 my ($pwd, $pwd2) = ($cgi->param('pwd'), $cgi->param('pwd2'));
310 $pwd ||= ''; $pwd2 ||= ''; # in case passwords are disabled
311 if ($pwd or not $self->{crypt}) {
312 $self->{crypt} = scrypt($pwd);
315 if ($pwd2 and $pwd ne $pwd2) {
316 $gcgi->err("Our high-paid security consultants have determined that the admin passwords you have entered do not match each other.");
319 $self->{cpwd} = $cgi->param('cpwd');
321 if ($Girocco::Config::project_owners eq 'email') {
322 $self->{email} = $gcgi->wparam('email');
323 valid_email($self->{email})
324 or $gcgi->err("Your email sure looks weird...?");
327 $self->{url} = $gcgi->wparam('url');
328 if ($self->{url}) {
329 valid_repo_url($self->{url})
330 or $gcgi->err("Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me.");
333 $self->{desc} = $gcgi->wparam('desc');
334 length($self->{desc}) <= 1024
335 or $gcgi->err("<b>Short</b> description length &gt; 1kb!");
337 $self->{README} = $gcgi->wparam('README');
338 length($self->{README}) <= 8192
339 or $gcgi->err("README length &gt; 8kb!");
341 $self->{hp} = $gcgi->wparam('hp');
342 if ($self->{hp}) {
343 valid_web_url($self->{hp})
344 or $gcgi->err("Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
347 # FIXME: Permit only existing users
348 $self->{users} = [grep { Girocco::User::valid_name($_) } $cgi->param('user')];
350 $self->{notifymail} = $gcgi->wparam('notifymail');
351 if ($self->{notifymail}) {
352 (valid_email_multi($self->{notifymail}) and length($self->{notifymail}) <= 512)
353 or $gcgi->err("Invalid notify e-mail address. Use mail,mail to specify multiple addresses; total length must not exceed 512 characters, however.");
356 $self->{notifyjson} = $gcgi->wparam('notifyjson');
357 if ($self->{notifyjson}) {
358 valid_web_url($self->{notifyjson})
359 or $gcgi->err("Invalid JSON notify URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
362 $self->{notifycia} = $gcgi->wparam('notifycia');
363 if ($self->{notifycia}) {
364 $self->{notifycia} =~ /^[a-zA-Z0-9._-]+$/
365 or $gcgi->err("Overly suspicious CIA notify project name. If it is actually valid, contact me.");
368 not $gcgi->err_check;
371 sub form_defaults {
372 my $self = shift;
374 name => $self->{name},
375 email => $self->{email},
376 url => $self->{url},
377 desc => html_esc($self->{desc}),
378 README => html_esc($self->{README}),
379 hp => $self->{hp},
380 users => $self->{users},
381 notifymail => html_esc($self->{notifymail}),
382 notifyjson => html_esc($self->{notifyjson}),
383 notifycia => html_esc($self->{notifycia}),
387 sub authenticate {
388 my $self = shift;
389 my ($gcgi) = @_;
391 $self->{ccrypt} or die "Can't authenticate against a project with no password";
392 $self->{cpwd} ||= '';
393 unless ($self->{ccrypt} eq crypt($self->{cpwd}, $self->{ccrypt})) {
394 $gcgi->err("Your admin password does not match!");
395 return 0;
397 return 1;
400 sub _setup {
401 my $self = shift;
402 my ($pushers) = @_;
404 $self->_mkdir_forkees;
406 mkdir($self->{path}) or die "mkdir $self->{path} failed: $!";
407 if ($Girocco::Config::owning_group) {
408 my $gid = scalar(getgrnam($Girocco::Config::owning_group));
409 chown(-1, $gid, $self->{path}) or die "chgrp $gid $self->{path} failed: $!";
410 chmod(02775, $self->{path}) or die "chmod 2775 $self->{path} failed: $!";
411 } else {
412 chmod(02777, $self->{path}) or die "chmod 2777 $self->{path} failed: $!";
414 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'init', '--bare', '--shared='.$self->shared_mode()) == 0
415 or die "git init $self->{path} failed: $?";
416 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'receive.denyNonFastforwards', 'false') == 0
417 or die "disabling receive.denyNonFastforwards failed: $?";
418 system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'gc.auto', '0') == 0
419 or die "disabling gc.auto failed: $?";
421 # /info must have right permissions even before the fixup job,
422 # and git init didn't do it for some reason.
423 if ($Girocco::Config::owning_group) {
424 chmod(02775, $self->{path}."/info") or die "chmod 2775 $self->{path}/info failed: $!";
425 } else {
426 chmod(02777, $self->{path}."/info") or die "chmod 2777 $self->{path}/info failed: $!";
429 $self->_properties_save;
430 $self->_alternates_setup;
431 $self->_ctags_setup;
432 $self->_group_add($pushers);
433 $self->_hooks_install;
434 $self->perm_initialize;
435 system($Girocco::Config::basedir . '/gitweb/genindex.sh');
438 sub premirror {
439 my $self = shift;
441 $self->_setup(':');
442 $self->_clonep(1);
445 sub conjure {
446 my $self = shift;
448 $self->_setup;
449 $self->_nofetch(1);
452 sub clone {
453 my $self = shift;
455 unlink ($self->_clonefail_path()); # Ignore EEXIST error
456 unlink ($self->_clonelog_path()); # Ignore EEXIST error
458 use IO::Socket;
459 my $sock = IO::Socket::UNIX->new($Girocco::Config::chroot.'/etc/taskd.socket') or die "cannot connect to taskd.socket: $!";
460 $sock->print("clone ".$self->{name}."\n");
461 # Just ignore reply, we are going to succeed anyway and the I/O
462 # would apparently get quite hairy.
463 $sock->flush();
464 sleep 2; # *cough*
465 $sock->close();
468 sub update {
469 my $self = shift;
471 $self->_properties_save;
472 $self->_group_update;
474 my @users_add = grep { $a = $_; not scalar grep { $a eq $_ } $self->{orig_users} } $self->{users};
475 my @users_del = grep { $a = $_; not scalar grep { $a eq $_ } $self->{users} } $self->{orig_users};
476 $self->perm_user_add($_, Girocco::User::resolve_uid($_)) foreach (@users_add);
477 $self->perm_user_del($_, Girocco::User::resolve_uid($_)) foreach (@users_del);
482 sub update_password {
483 my $self = shift;
484 my ($pwd) = @_;
486 $self->{crypt} = scrypt($pwd);
487 $self->_group_update;
490 # You can explicitly do this just on a ghost() repository too.
491 sub delete {
492 my $self = shift;
494 if (-d $self->{path}) {
495 system('rm', '-rf', $self->{path}) == 0
496 or die "rm -rf $self->{path} failed: $?";
498 $self->_group_remove;
501 sub has_forks {
502 my $self = shift;
504 return glob($Girocco::Config::reporoot.'/'.$self->{name}.'/*');
508 ### static methods
510 sub get_forkee_name {
511 $_ = $_[0];
512 (m#^(.*)/.*?$#)[0]; #
514 sub get_forkee_path {
515 my $forkee = $Girocco::Config::reporoot.'/'.get_forkee_name($_[0]).'.git';
516 -d $forkee ? $forkee : '';
519 sub valid_name {
520 $_ = $_[0];
521 (not m#/# or -d get_forkee_path($_)) # will also catch ^/
522 and (not m#\./#)
523 and (not m#/$#)
524 and m#^[a-zA-Z0-9+./_-]+$#;
527 sub does_exist {
528 my ($name) = @_;
529 valid_name($name) or die "tried to query for project with invalid name $name!";
530 (-d $Girocco::Config::reporoot."/$name.git");