Girocco/Project.pm

   1 package Girocco::Project;
   2
   3 use strict;
   4 use warnings;
   5
   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
  13 }
  14
  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 };
  20
  21 sub _mkdir_forkees {
  22         my $self = shift;
  23         my @pelems = split('/', $self->{name});
  24         pop @pelems; # do not create dir for the project itself
  25         my $path = $self->{base_path};
  26         foreach my $pelem (@pelems) {
  27                 $path .= "/$pelem";
  28                 (-d "$path") or mkdir $path or die "mkdir $path: $!";
  29                 chmod 0775, $path; # ok if fails (dir may already exist and be owned by someone else)
  30         }
  31 }
  32
  33 our %propmap = (
  34         url => 'base_url',
  35         email => 'owner',
  36         desc => 'description',
  37         README => 'README.html',
  38         hp => 'homepage',
  39 );
  40
  41 sub _property_path {
  42         my $self = shift;
  43         my ($name) = @_;
  44         $self->{path}.'/'.$name;
  45 }
  46
  47 sub _property_fget {
  48         my $self = shift;
  49         my ($name) = @_;
  50         $propmap{$name} or die "unknown property: $name";
  51         open P, $self->_property_path($propmap{$name}) or return undef;
  52         my @value = <P>;
  53         close P;
  54         my $value = join('', @value); chomp $value;
  55         $value;
  56 }
  57
  58 sub _property_fput {
  59         my $self = shift;
  60         my ($name, $value) = @_;
  61         $propmap{$name} or die "unknown property: $name";
  62         $value ||= '';
  63
  64         my $P = lock_file($self->_property_path($propmap{$name}));
  65         $value ne '' and print $P "$value\n";
  66         close $P;
  67         unlock_file($self->_property_path($propmap{$name}));
  68 }
  69
  70 sub _properties_load {
  71         my $self = shift;
  72         foreach my $prop (keys %propmap) {
  73                 $self->{$prop} = $self->_property_fget($prop);
  74         }
  75 }
  76
  77 sub _properties_save {
  78         my $self = shift;
  79         foreach my $prop (keys %propmap) {
  80                 $self->_property_fput($prop, $self->{$prop});
  81         }
  82 }
  83
  84 sub _nofetch_path {
  85         my $self = shift;
  86         $self->_property_path('.nofetch');
  87 }
  88
  89 sub _nofetch {
  90         my $self = shift;
  91         my ($nofetch) = @_;
  92         my $np = $self->_nofetch_path;
  93         if ($nofetch) {
  94                 open X, '>'.$np or die "nofetch failed: $!";
  95                 close X;
  96         } else {
  97                 unlink $np or die "yesfetch failed: $!";
  98         }
  99 }
 100
 101 sub _clonelog_path {
 102         my $self = shift;
 103         $self->_property_path('.clonelog');
 104 }
 105
 106 sub _clonefail_path {
 107         my $self = shift;
 108         $self->_property_path('.clone_failed');
 109 }
 110
 111 sub _clonep_path {
 112         my $self = shift;
 113         $self->_property_path('.clone_in_progress');
 114 }
 115
 116 sub _clonep {
 117         my $self = shift;
 118         my ($nofetch) = @_;
 119         my $np = $self->_clonep_path;
 120         if ($nofetch) {
 121                 open X, '>'.$np or die "clonep failed: $!";
 122                 close X;
 123         } else {
 124                 unlink $np or die "clonef failed: $!";
 125         }
 126 }
 127 sub _alternates_setup {
 128         my $self = shift;
 129         return unless $self->{name} =~ m#/#;
 130         my $forkee_name = get_forkee_name($self->{name});
 131         my $forkee_path = get_forkee_path($self->{name});
 132         return unless -d $forkee_path;
 133         mkdir $self->{path}.'/refs'; chmod 0775, $self->{path}.'/refs';
 134         mkdir $self->{path}.'/objects'; chmod 0775, $self->{path}.'/objects';
 135         mkdir $self->{path}.'/objects/info'; chmod 0775, $self->{path}.'/objects/info';
 136
 137         # We set up both alternates and http_alternates since we cannot use
 138         # relative path in alternates - that doesn't work recursively.
 139
 140         my $filename = $self->{path}.'/objects/info/alternates';
 141         open X, '>'.$filename or die "alternates failed: $!";
 142         print X "$forkee_path/objects\n";
 143         close X;
 144         chmod 0664, $filename or warn "cannot chmod $filename: $!";
 145
 146         if ($Girocco::Config::httppullurl) {
 147                 $filename = $self->{path}.'/objects/info/http-alternates';
 148                 open X, '>'.$filename or die "http-alternates failed: $!";
 149                 my $upfork = $forkee_name;
 150                 do { print X "$Girocco::Config::httppullurl/$upfork.git/objects\n"; } while ($upfork =~ s#/?.+?$## and $upfork); #
 151                 close X;
 152                 chmod 0664, $filename or warn "cannot chmod $filename: $!";
 153         }
 154
 155         symlink "$forkee_path/refs", $self->{path}.'/refs/forkee';
 156 }
 157
 158 sub _ctags_setup {
 159         my $self = shift;
 160         mkdir $self->{path}.'/ctags'; chmod 01777, $self->{path}.'/ctags';
 161 }
 162
 163 sub _group_add {
 164         my $self = shift;
 165         my ($xtra) = @_;
 166         $xtra .= join(',', @{$self->{users}});
 167         filedb_atomic_append(jailed_file('/etc/group'),
 168                 join(':', $self->{name}, $self->{crypt}, '\i', $xtra));
 169 }
 170
 171 sub _group_update {
 172         my $self = shift;
 173         my $xtra = join(',', @{$self->{users}});
 174         filedb_atomic_edit(jailed_file('/etc/group'),
 175                 sub {
 176                         $_ = $_[0];
 177                         chomp;
 178                         if ($self->{name} eq (split /:/)[0]) {
 179                                 # preserve readonly flag
 180                                 s/::([^:]*)$/:$1/ and $xtra = ":$xtra";
 181                                 return join(':', $self->{name}, $self->{crypt}, $self->{gid}, $xtra)."\n";
 182                         } else {
 183                                 return "$_\n";
 184                         }
 185                 }
 186         );
 187 }
 188
 189 sub _group_remove {
 190         my $self = shift;
 191         filedb_atomic_edit(jailed_file('/etc/group'),
 192                 sub {
 193                         $self->{name} ne (split /:/)[0] and return $_;
 194                 }
 195         );
 196 }
 197
 198 sub _hook_path {
 199         my $self = shift;
 200         my ($name) = @_;
 201         $self->{path}.'/hooks/'.$name;
 202 }
 203
 204 sub _hook_install {
 205         my $self = shift;
 206         my ($name) = @_;
 207         open SRC, "$Girocco::Config::basedir/$name-hook" or die "cannot open hook $name: $!";
 208         open DST, '>'.$self->_hook_path($name) or die "cannot open hook $name for writing: $!";
 209         while (<SRC>) { print DST $_; }
 210         close DST;
 211         close SRC;
 212         chmod 0775, $self->_hook_path($name) or die "cannot chmod hook $name: $!";
 213 }
 214
 215 sub _hooks_install {
 216         my $self = shift;
 217         foreach my $hook ('update') {
 218                 $self->_hook_install($hook);
 219         }
 220 }
 221
 222 # private constructor, do not use
 223 sub _new {
 224         my $class = shift;
 225         my ($name, $base_path, $path) = @_;
 226         valid_name($name) or die "refusing to create project with invalid name ($name)!";
 227         $path ||= "$base_path/$name.git";
 228         my $proj = { name => $name, base_path => $base_path, path => $path };
 229
 230         bless $proj, $class;
 231 }
 232
 233 # public constructor #0
 234 # creates a virtual project not connected to disk image
 235 # you can conjure() it later to disk
 236 sub ghost {
 237         my $class = shift;
 238         my ($name, $mirror) = @_;
 239         my $self = $class->_new($name, $Girocco::Config::reporoot);
 240         $self->{users} = [];
 241         $self->{mirror} = $mirror;
 242         $self;
 243 }
 244
 245 # public constructor #1
 246 sub load {
 247         my $class = shift;
 248         my ($name) = @_;
 249
 250         open F, jailed_file("/etc/group") or die "project load failed: $!";
 251         while (<F>) {
 252                 chomp;
 253                 @_ = split /:+/;
 254                 next unless (shift eq $name);
 255
 256                 my $self = $class->_new($name, $Girocco::Config::reporoot);
 257                 (-d $self->{path}) or die "invalid path (".$self->{path}.") for project ".$self->{name};
 258
 259                 my $ulist;
 260                 ($self->{crypt}, $self->{gid}, $ulist) = @_;
 261                 $ulist ||= '';
 262                 $self->{users} = [split /,/, $ulist];
 263                 $self->{orig_users} = [@{$self->{users}}];
 264                 $self->{mirror} = ! -e $self->_nofetch_path;
 265                 $self->{clone_in_progress} = -e $self->_clonep_path;
 266                 $self->{clone_logged} = -e $self->_clonelog_path;
 267                 $self->{clone_failed} = -e $self->_clonefail_path;
 268                 $self->{ccrypt} = $self->{crypt};
 269
 270                 $self->_properties_load;
 271                 return $self;
 272         }
 273         close F;
 274         undef;
 275 }
 276
 277 # $proj may not be in sane state if this returns false!
 278 sub cgi_fill {
 279         my $self = shift;
 280         my ($gcgi) = @_;
 281         my $cgi = $gcgi->cgi;
 282
 283         my ($pwd, $pwd2) = ($cgi->param('pwd'), $cgi->param('pwd2'));
 284         $pwd ||= ''; $pwd2 ||= ''; # in case passwords are disabled
 285         if ($pwd or not $self->{crypt}) {
 286                 $self->{crypt} = scrypt($pwd);
 287         }
 288
 289         if ($pwd2 and $pwd ne $pwd2) {
 290                 $gcgi->err("Our high-paid security consultants have determined that the admin passwords you have entered do not match each other.");
 291         }
 292
 293         $self->{cpwd} = $cgi->param('cpwd');
 294
 295         if ($Girocco::Config::project_owners eq 'email') {
 296                 $self->{email} = $gcgi->wparam('email');
 297                 valid_email($self->{email})
 298                         or $gcgi->err("Your email sure looks weird...?");
 299         }
 300
 301         $self->{url} = $gcgi->wparam('url');
 302         if ($self->{url}) {
 303                 valid_repo_url($self->{url})
 304                         or $gcgi->err("Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me.");
 305         }
 306
 307         $self->{desc} = $gcgi->wparam('desc');
 308         length($self->{desc}) <= 1024
 309                 or $gcgi->err("<b>Short</b> description length &gt; 1kb!");
 310
 311         $self->{README} = $gcgi->wparam('README');
 312         length($self->{README}) <= 8192
 313                 or $gcgi->err("README length &gt; 8kb!");
 314
 315         $self->{hp} = $gcgi->wparam('hp');
 316         if ($self->{hp}) {
 317                 valid_web_url($self->{hp})
 318                         or $gcgi->err("Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.");
 319         }
 320
 321         # FIXME: Permit only existing users
 322         $self->{users} = [grep { Girocco::User::valid_name($_) } $cgi->param('user')];
 323
 324         not $gcgi->err_check;
 325 }
 326
 327 sub form_defaults {
 328         my $self = shift;
 329         (
 330                 name => $self->{name},
 331                 email => $self->{email},
 332                 url => $self->{url},
 333                 desc => html_esc($self->{desc}),
 334                 README => html_esc($self->{README}),
 335                 hp => $self->{hp},
 336                 users => $self->{users},
 337         );
 338 }
 339
 340 sub authenticate {
 341         my $self = shift;
 342         my ($gcgi) = @_;
 343
 344         $self->{ccrypt} or die "Can't authenticate against a project with no password";
 345         $self->{cpwd} ||= '';
 346         unless ($self->{ccrypt} eq crypt($self->{cpwd}, $self->{ccrypt})) {
 347                 $gcgi->err("Your admin password does not match!");
 348                 return 0;
 349         }
 350         return 1;
 351 }
 352
 353 sub _setup {
 354         my $self = shift;
 355         my ($pushers) = @_;
 356
 357         $self->_mkdir_forkees;
 358
 359         mkdir($self->{path}) or die "mkdir $self->{path} failed: $!";
 360         if ($Girocco::Config::owning_group) {
 361                 my $gid = scalar(getgrnam($Girocco::Config::owning_group));
 362                 chown(-1, $gid, $self->{path}) or die "chgrp $gid $self->{path} failed: $!";
 363                 chmod(02775, $self->{path}) or die "chmod 2775 $self->{path} failed: $!";
 364         } else {
 365                 chmod(02777, $self->{path}) or die "chmod 2777 $self->{path} failed: $!";
 366         }
 367         system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'init', '--bare', '--shared='.$self->shared_mode()) == 0
 368                 or die "git init $self->{path} failed: $?";
 369         system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'receive.denyNonFastforwards', 'false') == 0
 370                 or die "disabling receive.denyNonFastforwards failed: $?";
 371         system($Girocco::Config::git_bin, '--git-dir='.$self->{path}, 'config', 'gc.auto', '0') == 0
 372                 or die "disabling gc.auto failed: $?";
 373
 374         $self->_properties_save;
 375         $self->_alternates_setup;
 376         $self->_ctags_setup;
 377         $self->_group_add($pushers);
 378         $self->_hooks_install;
 379         $self->perm_initialize;
 380 }
 381
 382 sub premirror {
 383         my $self = shift;
 384
 385         $self->_setup(':');
 386         $self->_clonep(1);
 387 }
 388
 389 sub conjure {
 390         my $self = shift;
 391
 392         $self->_setup;
 393         $self->_nofetch(1);
 394 }
 395
 396 sub clone {
 397         my $self = shift;
 398
 399         unlink ($self->_clonefail_path()); # Ignore EEXIST error
 400
 401         use IO::Socket;
 402         my $sock = IO::Socket::UNIX->new('/tmp/girocco.cloned') or die "cannot connect to girocco.cloned: $!";
 403         $sock->print($self->{name}.".git\n");
 404         # Just ignore reply, we are going to succeed anyway and the I/O
 405         # would apparently get quite hairy.
 406         $sock->flush();
 407         sleep 2; # *cough*
 408         $sock->close();
 409 }
 410
 411 sub update {
 412         my $self = shift;
 413
 414         $self->_properties_save;
 415         $self->_group_update;
 416
 417         my @users_add = grep { $a = $_; not scalar grep { $a eq $_ } $self->{orig_users} } $self->{users};
 418         my @users_del = grep { $a = $_; not scalar grep { $a eq $_ } $self->{users} } $self->{orig_users};
 419         $self->perm_user_add($_, Girocco::User::resolve_uid($_)) foreach (@users_add);
 420         $self->perm_user_del($_, Girocco::User::resolve_uid($_)) foreach (@users_del);
 421
 422         1;
 423 }
 424
 425 sub update_password {
 426         my $self = shift;
 427         my ($pwd) = @_;
 428
 429         $self->{crypt} = scrypt($pwd);
 430         $self->_group_update;
 431 }
 432
 433 # You can explicitly do this just on a ghost() repository too.
 434 sub delete {
 435         my $self = shift;
 436
 437         if (-d $self->{path}) {
 438                 system('rm', '-rf', $self->{path}) == 0
 439                         or die "rm -rf $self->{path} failed: $?";
 440         }
 441         $self->_group_remove;
 442 }
 443
 444 sub has_forks {
 445         my $self = shift;
 446
 447         return glob($Girocco::Config::reporoot.'/'.$self->{name}.'/*');
 448 }
 449
 450
 451 ### static methods
 452
 453 sub get_forkee_name {
 454         $_ = $_[0];
 455         (m#^(.*)/.*?$#)[0]; #
 456 }
 457 sub get_forkee_path {
 458         my $forkee = $Girocco::Config::reporoot.'/'.get_forkee_name($_[0]).'.git';
 459         -d $forkee ? $forkee : '';
 460 }
 461
 462 sub valid_name {
 463         $_ = $_[0];
 464         (not m#/# or -d get_forkee_path($_)) # will also catch ^/
 465                 and (not m#\./#)
 466                 and (not m#/$#)
 467                 and m#^[a-zA-Z0-9+./_-]+$#;
 468 }
 469
 470 sub does_exist {
 471         my ($name) = @_;
 472         valid_name($name) or die "tried to query for project with invalid name $name!";
 473         available($name);
 474 }
 475 sub available {
 476         my ($name) = @_;
 477         valid_name($name) or die "tried to query for project with invalid name $name!";
 478         (-d $Girocco::Config::reporoot."/$name.git");
 479 }
 480
 481
 482 1;