cgi/p/editproj.cgi

   1 #!/usr/bin/perl
   2 # (c) Petr Baudis <pasky@suse.cz>
   3 # GPLv2
   4
   5 use strict;
   6 use warnings;
   7
   8 use lib qw(/home/repo/repomgr/cgi);
   9 use Git::RepoCGI;
  10
  11 my $repo = Git::RepoCGI->new('Project Settings');
  12 my $cgi = $repo->cgi;
  13
  14 my $name = $cgi->remote_user();
  15
  16 if (! -d "/srv/git/$name.git") {
  17         print "<p>Sorry but your project has not finished mirroring yet. If it takes inordinate amount of time, please tell the administrator.</p>\n";
  18         exit;
  19 }
  20
  21 sub load_project {
  22         my ($name) = @_;
  23         my ($email, $url, $desc, $hp, $crypt, $gid, @users);
  24         open F, jailed_file("/etc/group") or die "load_project failed: $!";
  25         while (<F>) {
  26                 chomp;
  27                 @_ = split /:+/;
  28                 next unless (shift eq $name);
  29
  30                 my $ulist;
  31                 ($crypt, $gid, $ulist) = @_;
  32                 @users = split /,/, $ulist;
  33
  34                 open G, "/srv/git/$name.git/base_url" or die "base_url failed: $!"; chomp($url = <G>); close G;
  35                 open G, "/srv/git/$name.git/owner" or die "owner failed: $!"; chomp($email = <G>); close G;
  36                 open G, "/srv/git/$name.git/description" or die "desc failed: $!"; chomp($desc = <G>); close G;
  37                 open G, "/srv/git/$name.git/homepage" or die "hp failed: $!"; chomp($hp = <G>); close G;
  38
  39                 return ($email, $url, $desc, $hp, $crypt, $gid, @users);
  40         }
  41         close F;
  42         die "not found project $name, that's really weird!";
  43 }
  44
  45 my ($email, $url, $desc, $hp, $crypt, $gid, @users) = load_project($name);
  46
  47 sub save_proj_data {
  48         my ($path, $url, $email, $desc, $hp) = @_;
  49         open F, ">$path/base_url" or die "base_url failed: $!"; print F "$url\n"; close F;
  50         open F, ">$path/owner" or die "owner failed: $!"; print F "$email\n"; close F;
  51         open F, ">$path/description" or die "desc failed: $!"; print F "$desc\n"; close F;
  52         open F, ">$path/homepage" or die "hp failed: $!"; print F "$hp\n"; close F;
  53 }
  54
  55 sub edit_group {
  56         my ($gid, $name, $pwd, $xtra) = @_;
  57         filedb_atomic_edit($file,
  58                 sub {
  59                         $_ = $_[0];
  60                         chomp;
  61                         if ($name eq (split /:/)[0]) {
  62                                 s/::([^:]*)$/:$1/ and $xtra = ":$xtra";
  63                                 return "$name:$pwd:$gid:$xtra\n";
  64                         } else {
  65                                 return "$_\n";
  66                         }
  67                 }
  68         );
  69 }
  70
  71 sub update_project {
  72         my ($gid, $name, $pwd, $email, $url, $desc, $hp, @users) = @_;
  73         save_proj_data("/srv/git/$name.git", $url, $email, $desc, $hp);
  74         edit_group($gid, $name, $pwd, join(',', @users));
  75         print "<p>Project successfuly updated.</p>\n";
  76 }
  77
  78 if ($cgi->param('email')) {
  79         # submitted, let's see
  80         # FIXME: racy, do a lock
  81         $email = $repo->wparam('email');
  82         $url = $repo->wparam('url');
  83         $desc = $repo->wparam('desc');
  84         $hp = $repo->wparam('hp');
  85         @users = grep { $_ =~ /^[a-zA-Z0-9_+-]+$/ } $cgi->param('user');
  86         my $pwd = $cgi->param('pwd');
  87         if ($url) {
  88                 $url =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ or
  89                 $url =~ /^git:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/
  90                         or $repo->err "Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me.";
  91         }
  92         if ($hp) {
  93                 $hp =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/
  94                         or $repo->err "Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me.";
  95         }
  96         $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/
  97                 or $repo->err "Your email sure looks weird...?";
  98         length($desc) <= 1024
  99                 or $repo->err "<b>Short</b> description length > 1kb!";
 100         unless ($repo->err_check) {
 101                 if ($pwd) {
 102                         $pwd = scrypt($pwd);
 103                 } else {
 104                         $pwd = $crypt;
 105                 }
 106                 update_project($gid, $name, $pwd, $email, $url, $desc, $hp, @users);
 107         }
 108 }
 109
 110 my $hesc = html_esc($desc);
 111
 112 print <<EOT;
 113 <p>Here you can adjust project settings. Go wild. Only you can currently enable access only for a single user at a time so perhaps you will need to click a lot.</p>
 114 <form method="post">
 115 <p>Project name (w/o the .git suffix): $name</p>
 116 <p>Admin password: <input type="password" name="pwd" /> (leave empty to keep it at the current value)</p>
 117 <p>E-mail contact: <input type="text" name="email" value="$email" /></p>
 118 <p>Repository URL: <input type="text" name="url" value="$url" /></p>
 119 <p>Description: <input type="text" name="desc" value="$desc" /></p>
 120 <p>Homepage URL: <input type="text" name="hp" value="$hp" /></p>
 121 <p>Users:</p>
 122 <ul>
 123 EOT
 124 foreach my $user (@users) {
 125         print "<li><input type=\"checkbox\" name=\"user\" value=\"$user\" checked=\"1\" /> $user</li>\n";
 126 }
 127 print <<EOT;
 128 <li>Add user: <input type="text" name="user" /></li>
 129 </ul>
 130 <p><input type="submit" name="y0" value="Update" /></p>
 131 </form>
 132 EOT