From 996955e7a6eb2d1085e21ccb332d600c85fb8b6e Mon Sep 17 00:00:00 2001 From: Petr Baudis Date: Tue, 10 Oct 2006 00:16:16 +0200 Subject: [PATCH] Reintent to tabsize 8 --- cgi/Git/RepoCGI.pm | 12 +-- cgi/p/editproj.cgi | 294 ++++++++++++++++++++++++++--------------------------- cgi/regproj.cgi | 134 ++++++++++++------------ cgi/reguser.cgi | 74 +++++++------- 4 files changed, 257 insertions(+), 257 deletions(-) rewrite cgi/p/editproj.cgi (73%) diff --git a/cgi/Git/RepoCGI.pm b/cgi/Git/RepoCGI.pm index b4e525a..803b487 100644 --- a/cgi/Git/RepoCGI.pm +++ b/cgi/Git/RepoCGI.pm @@ -92,15 +92,15 @@ sub wparam { ### Random utility functions sub scrypt { - my ($pwd) = @_; - crypt($pwd, join ('', ('.', '/', 2..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])); + my ($pwd) = @_; + crypt($pwd, join ('', ('.', '/', 2..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])); } sub html_esc { - my ($str) = @_; - $str =~ s/&/&/g; - $str =~ s//>/g; - $str =~ s/"/"/g; + my ($str) = @_; + $str =~ s/&/&/g; + $str =~ s//>/g; + $str =~ s/"/"/g; } diff --git a/cgi/p/editproj.cgi b/cgi/p/editproj.cgi dissimilarity index 73% index 44ae832..218bac5 100755 --- a/cgi/p/editproj.cgi +++ b/cgi/p/editproj.cgi @@ -1,147 +1,147 @@ -#!/usr/bin/perl -# (c) Petr Baudis -# GPLv2 - -use strict; -use warnings; - -use lib qw(/home/repo/repomgr/cgi); -use Git::RepoCGI; - -my $repo = Git::RepoCGI->new('Project Settings'); -my $cgi = $repo->cgi; - -my $name = $cgi->remote_user(); - -if (! -d "/srv/git/$name.git") { - print "

Sorry but your project has not finished mirroring yet. If it takes inordinate amount of time, please tell the administrator.

\n"; - exit; -} - -sub load_project { - my ($name) = @_; - my ($email, $url, $desc, $hp, $crypt, $gid, @users); - open F, "/home/repo/j/etc/group" or die "load_project failed: $!"; - while () { - chomp; - @_ = split /:+/; - next unless (shift eq $name); - - my $ulist; - ($crypt, $gid, $ulist) = @_; - @users = split /,/, $ulist; - - open G, "/srv/git/$name.git/base_url" or die "base_url failed: $!"; chomp($url = ); close G; - open G, "/srv/git/$name.git/owner" or die "owner failed: $!"; chomp($email = ); close G; - open G, "/srv/git/$name.git/description" or die "desc failed: $!"; chomp($desc = ); close G; - open G, "/srv/git/$name.git/homepage" or die "hp failed: $!"; chomp($hp = ); close G; - - return ($email, $url, $desc, $hp, $crypt, $gid, @users); - } - close F; - die "not found project $name, that's really weird!"; -} - -my ($email, $url, $desc, $hp, $crypt, $gid, @users) = load_project($name); - -sub scrypt { - my ($pwd) = @_; - crypt($pwd, join ('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])); -} - -sub save_proj_data { - my ($path, $url, $email, $desc, $hp) = @_; - open F, ">$path/base_url" or die "base_url failed: $!"; print F "$url\n"; close F; - open F, ">$path/owner" or die "owner failed: $!"; print F "$email\n"; close F; - open F, ">$path/description" or die "desc failed: $!"; print F "$desc\n"; close F; - open F, ">$path/homepage" or die "hp failed: $!"; print F "$hp\n"; close F; -} - -sub edit_group { - my ($gid, $name, $pwd, $xtra) = @_; - # racy! - # at least basic protection, but there's still race window; I suck - my ($size, $__, $mtime) = splice(@{[stat "/home/repo/j/etc/group"]}, 7, 3); - open F, "/home/repo/j/etc/group" or die "group failed: $!"; - open G, ">/home/repo/j/etc/group.$$" or die "repogroup failed: $!"; - while () { - chomp; - if ($name eq (split /:/)[0]) { - s/::([^:]*)$/:$1/ and $xtra = ":$xtra"; - print G "$name:$pwd:$gid:$xtra\n"; - } else { - print G "$_\n"; - } - } - close G; - close F; - my ($size2, $__2, $mtime2) = splice(@{[stat "/home/repo/j/etc/group"]}, 7, 3); - if ($size2 ne $size or $mtime2 ne $mtime) { - die "sorry, hit a race window; please try submitting again"; - } - chmod 0664, "/home/repo/j/etc/group.$$" or die "chmod failed: $!"; - rename "/home/repo/j/etc/group.$$", "/home/repo/j/etc/group" or die "rename failed: $!"; -} - -sub update_project { - my ($gid, $name, $pwd, $email, $url, $desc, $hp, @users) = @_; - save_proj_data("/srv/git/$name.git", $url, $email, $desc, $hp); - edit_group($gid, $name, $pwd, join(',', @users)); - print "

Project successfuly updated.

\n"; -} - -if ($cgi->param('email')) { - # submitted, let's see - # FIXME: racy, do a lock - $email = $repo->wparam('email'); - $url = $repo->wparam('url'); - $desc = $repo->wparam('desc'); - $hp = $repo->wparam('hp'); - @users = grep { $_ =~ /^[a-zA-Z0-9_+-]+$/ } $cgi->param('user'); - my $pwd = $cgi->param('pwd'); - if ($url) { - $url =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ or - $url =~ /^git:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ - or $repo->err "Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me."; - } - if ($hp) { - $hp =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ - or $repo->err "Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me."; - } - $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/ - or $repo->err "Your email sure looks weird...?"; - length($desc) <= 1024 - or $repo->err "Short description length > 1kb!"; - unless ($repo->err_check) { - if ($pwd) { - $pwd = scrypt($pwd); - } else { - $pwd = $crypt; - } - update_project($gid, $name, $pwd, $email, $url, $desc, $hp, @users); - } -} - -my $hesc = html_esc($desc); - -print <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.

-
-

Project name (w/o the .git suffix): $name

-

Admin password: (leave empty to keep it at the current value)

-

E-mail contact:

-

Repository URL:

-

Description:

-

Homepage URL:

-

Users:

-
    -EOT -foreach my $user (@users) { - print "
  • $user
    • \n"; -} -print <Add user: -
-

-
-EOT +#!/usr/bin/perl +# (c) Petr Baudis +# GPLv2 + +use strict; +use warnings; + +use lib qw(/home/repo/repomgr/cgi); +use Git::RepoCGI; + +my $repo = Git::RepoCGI->new('Project Settings'); +my $cgi = $repo->cgi; + +my $name = $cgi->remote_user(); + +if (! -d "/srv/git/$name.git") { + print "

Sorry but your project has not finished mirroring yet. If it takes inordinate amount of time, please tell the administrator.

\n"; + exit; +} + +sub load_project { + my ($name) = @_; + my ($email, $url, $desc, $hp, $crypt, $gid, @users); + open F, "/home/repo/j/etc/group" or die "load_project failed: $!"; + while () { + chomp; + @_ = split /:+/; + next unless (shift eq $name); + + my $ulist; + ($crypt, $gid, $ulist) = @_; + @users = split /,/, $ulist; + + open G, "/srv/git/$name.git/base_url" or die "base_url failed: $!"; chomp($url = ); close G; + open G, "/srv/git/$name.git/owner" or die "owner failed: $!"; chomp($email = ); close G; + open G, "/srv/git/$name.git/description" or die "desc failed: $!"; chomp($desc = ); close G; + open G, "/srv/git/$name.git/homepage" or die "hp failed: $!"; chomp($hp = ); close G; + + return ($email, $url, $desc, $hp, $crypt, $gid, @users); + } + close F; + die "not found project $name, that's really weird!"; +} + +my ($email, $url, $desc, $hp, $crypt, $gid, @users) = load_project($name); + +sub scrypt { + my ($pwd) = @_; + crypt($pwd, join ('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])); +} + +sub save_proj_data { + my ($path, $url, $email, $desc, $hp) = @_; + open F, ">$path/base_url" or die "base_url failed: $!"; print F "$url\n"; close F; + open F, ">$path/owner" or die "owner failed: $!"; print F "$email\n"; close F; + open F, ">$path/description" or die "desc failed: $!"; print F "$desc\n"; close F; + open F, ">$path/homepage" or die "hp failed: $!"; print F "$hp\n"; close F; +} + +sub edit_group { + my ($gid, $name, $pwd, $xtra) = @_; + # racy! + # at least basic protection, but there's still race window; I suck + my ($size, $__, $mtime) = splice(@{[stat "/home/repo/j/etc/group"]}, 7, 3); + open F, "/home/repo/j/etc/group" or die "group failed: $!"; + open G, ">/home/repo/j/etc/group.$$" or die "repogroup failed: $!"; + while () { + chomp; + if ($name eq (split /:/)[0]) { + s/::([^:]*)$/:$1/ and $xtra = ":$xtra"; + print G "$name:$pwd:$gid:$xtra\n"; + } else { + print G "$_\n"; + } + } + close G; + close F; + my ($size2, $__2, $mtime2) = splice(@{[stat "/home/repo/j/etc/group"]}, 7, 3); + if ($size2 ne $size or $mtime2 ne $mtime) { + die "sorry, hit a race window; please try submitting again"; + } + chmod 0664, "/home/repo/j/etc/group.$$" or die "chmod failed: $!"; + rename "/home/repo/j/etc/group.$$", "/home/repo/j/etc/group" or die "rename failed: $!"; +} + +sub update_project { + my ($gid, $name, $pwd, $email, $url, $desc, $hp, @users) = @_; + save_proj_data("/srv/git/$name.git", $url, $email, $desc, $hp); + edit_group($gid, $name, $pwd, join(',', @users)); + print "

Project successfuly updated.

\n"; +} + +if ($cgi->param('email')) { + # submitted, let's see + # FIXME: racy, do a lock + $email = $repo->wparam('email'); + $url = $repo->wparam('url'); + $desc = $repo->wparam('desc'); + $hp = $repo->wparam('hp'); + @users = grep { $_ =~ /^[a-zA-Z0-9_+-]+$/ } $cgi->param('user'); + my $pwd = $cgi->param('pwd'); + if ($url) { + $url =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ or + $url =~ /^git:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ + or $repo->err "Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me."; + } + if ($hp) { + $hp =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ + or $repo->err "Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me."; + } + $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/ + or $repo->err "Your email sure looks weird...?"; + length($desc) <= 1024 + or $repo->err "Short description length > 1kb!"; + unless ($repo->err_check) { + if ($pwd) { + $pwd = scrypt($pwd); + } else { + $pwd = $crypt; + } + update_project($gid, $name, $pwd, $email, $url, $desc, $hp, @users); + } +} + +my $hesc = html_esc($desc); + +print <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.

+
+

Project name (w/o the .git suffix): $name

+

Admin password: (leave empty to keep it at the current value)

+

E-mail contact:

+

Repository URL:

+

Description:

+

Homepage URL:

+

Users:

+
    +EOT +foreach my $user (@users) { + print "
  • $user
    • \n"; +} +print <Add user: +
+

+
+EOT diff --git a/cgi/regproj.cgi b/cgi/regproj.cgi index 620ad7d..328ea0e 100755 --- a/cgi/regproj.cgi +++ b/cgi/regproj.cgi @@ -12,37 +12,37 @@ my $repo = Git::RepoCGI->new('Project Registration'); my $cgi = $repo->cgi; sub save_proj_data { - my ($path, $url, $email, $desc, $hp) = @_; - open F, ">$path/base_url" or die "base_url failed: $!"; print F "$url\n"; close F; - open F, ">$path/owner" or die "owner failed: $!"; print F "$email\n"; close F; - open F, ">$path/description" or die "desc failed: $!"; print F "$desc\n"; close F; - open F, ">$path/homepage" or die "hp failed: $!"; print F "$hp\n"; close F; + my ($path, $url, $email, $desc, $hp) = @_; + open F, ">$path/base_url" or die "base_url failed: $!"; print F "$url\n"; close F; + open F, ">$path/owner" or die "owner failed: $!"; print F "$email\n"; close F; + open F, ">$path/description" or die "desc failed: $!"; print F "$desc\n"; close F; + open F, ">$path/homepage" or die "hp failed: $!"; print F "$hp\n"; close F; } sub add_group { - my ($name, $pwd, $xtra) = @_; - my $gid = 65536; - # racy! - open F, "/home/repo/j/etc/group" or die "group failed: $!"; - while () { - my $agid = (split /:/)[2]; - $gid = $agid + 1 if ($agid >= $gid); - } - close F; - open F, ">>/home/repo/j/etc/group" or die "group append failed: $!"; - print F "$name:".scrypt($pwd).":$gid:$xtra\n"; - close F; - $gid; + my ($name, $pwd, $xtra) = @_; + my $gid = 65536; + # racy! + open F, "/home/repo/j/etc/group" or die "group failed: $!"; + while () { + my $agid = (split /:/)[2]; + $gid = $agid + 1 if ($agid >= $gid); + } + close F; + open F, ">>/home/repo/j/etc/group" or die "group append failed: $!"; + print F "$name:".scrypt($pwd).":$gid:$xtra\n"; + close F; + $gid; } sub setup_push { - my ($name, $pwd, $email, $url, $desc, $hp) = @_; - system("cg-admin-setuprepo -g repo /srv/git/$name.git") == 0 or die "cg-admin-setuprepo failed: $?"; - open X, ">/srv/git/$name.git/.nofetch" or die "nofetch failed: $!"; close X; - save_proj_data("/srv/git/$name.git", $url, $email, $desc, $hp); - chmod 0664, map { "/srv/git/$name.git/$_" } qw(base_url owner description homepage); - add_group($name, $pwd, ''); - print </srv/git/$name.git/.nofetch" or die "nofetch failed: $!"; close X; + save_proj_data("/srv/git/$name.git", $url, $email, $desc, $hp); + chmod 0664, map { "/srv/git/$name.git/$_" } qw(base_url owner description homepage); + add_group($name, $pwd, ''); + print < Project successfuly set up. You can assign users now (use project name as username, admin password as password). @@ -55,51 +55,51 @@ EOT } sub setup_mirror { - my ($name, $pwd, $email, $url, $desc, $hp) = @_; - mkdir "/home/repo/repodata/to-clone/$name" or die "mkdir failed: $!"; - save_proj_data("/home/repo/repodata/to-clone/$name", $url, $email, $desc, $hp); - chmod 0775, "/home/repo/repodata/to-clone/$name" or die "chmod failed: $!"; - add_group($name, $pwd, ':'); - print "

Initiated mirroring. You will be notified by mail about results.

\n"; + my ($name, $pwd, $email, $url, $desc, $hp) = @_; + mkdir "/home/repo/repodata/to-clone/$name" or die "mkdir failed: $!"; + save_proj_data("/home/repo/repodata/to-clone/$name", $url, $email, $desc, $hp); + chmod 0775, "/home/repo/repodata/to-clone/$name" or die "chmod failed: $!"; + add_group($name, $pwd, ':'); + print "

Initiated mirroring. You will be notified by mail about results.

\n"; } if ($cgi->param('name')) { - # submitted, let's see - # FIXME: racy, do a lock - my $name = $repo->wparam('name'); - my $email = $repo->wparam('email'); - my $url = $repo->wparam('url'); - my $desc = $repo->wparam('desc'); - my $hp = $repo->wparam('hp'); - my $pwd = $cgi->param('pwd'); - $name =~ /^[a-zA-Z0-9_+-]+$/ - or $repo->err "Name contains invalid characters."; - (-d "/srv/git/$name.git" or -d "/home/repo/repodata/cloning/$name" or -d "/home/repo/repodata/to-clone/$name") - and $repo->err "Project with that name already exists."; - if ($url) { - $url =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ or - $url =~ /^git:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ - or $repo->err "Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me."; - } else { - $cgi->param('mode') eq 'mirror' - and $repo->err "Missing URL."; - } - if ($hp) { - $hp =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ - or $repo->err "Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me."; - } - $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/ - or $repo->err "Your email sure looks weird...?"; - length($desc) <= 1024 - or $repo->err "Short description length > 1kb!"; - unless ($repo->err_check) { - if ($cgi->param('mode') eq 'mirror') { - setup_mirror($name, $pwd, $email, $url, $desc, $hp); - } elsif ($cgi->param('mode') eq 'push') { - setup_push($name, $pwd, $email, $url, $desc, $hp); - } - exit; - } + # submitted, let's see + # FIXME: racy, do a lock + my $name = $repo->wparam('name'); + my $email = $repo->wparam('email'); + my $url = $repo->wparam('url'); + my $desc = $repo->wparam('desc'); + my $hp = $repo->wparam('hp'); + my $pwd = $cgi->param('pwd'); + $name =~ /^[a-zA-Z0-9_+-]+$/ + or $repo->err "Name contains invalid characters."; + (-d "/srv/git/$name.git" or -d "/home/repo/repodata/cloning/$name" or -d "/home/repo/repodata/to-clone/$name") + and $repo->err "Project with that name already exists."; + if ($url) { + $url =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ or + $url =~ /^git:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ + or $repo->err "Invalid URL. Note that only HTTP and Git protocol is supported. If the URL contains funny characters, contact me."; + } else { + $cgi->param('mode') eq 'mirror' + and $repo->err "Missing URL."; + } + if ($hp) { + $hp =~ /^http:\/\/[a-zA-Z0-9-.]+\/[_\%a-zA-Z0-9.\/~-]+$/ + or $repo->err "Invalid homepage URL. Note that only HTTP protocol is supported. If the URL contains funny characters, contact me."; + } + $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/ + or $repo->err "Your email sure looks weird...?"; + length($desc) <= 1024 + or $repo->err "Short description length > 1kb!"; + unless ($repo->err_check) { + if ($cgi->param('mode') eq 'mirror') { + setup_mirror($name, $pwd, $email, $url, $desc, $hp); + } elsif ($cgi->param('mode') eq 'push') { + setup_push($name, $pwd, $email, $url, $desc, $hp); + } + exit; + } } print <new('User Registration'); my $cgi = $repo->cgi; sub add_user { - my ($name, $email) = @_; - my $uid = 65536; - # racy! - open F, "/home/repo/j/etc/passwd" or die "passwd failed: $!"; - while () { - my $auid = (split /:/)[2]; - $uid = $auid + 1 if ($auid >= $uid); - } - close F; - open F, ">>/home/repo/j/etc/passwd" or die "passwd append failed: $!"; - print F "$name:x:$uid:65534:$email:/:/bin/git-shell\n"; - close F; - $uid; + my ($name, $email) = @_; + my $uid = 65536; + # racy! + open F, "/home/repo/j/etc/passwd" or die "passwd failed: $!"; + while () { + my $auid = (split /:/)[2]; + $uid = $auid + 1 if ($auid >= $uid); + } + close F; + open F, ">>/home/repo/j/etc/passwd" or die "passwd append failed: $!"; + print F "$name:x:$uid:65534:$email:/:/bin/git-shell\n"; + close F; + $uid; } sub setup_user { - my ($name, $email, $keys) = @_; - add_user($name, $email); - open F, ">/home/repo/j/etc/sshkeys/$name" or die "sshkey failed: $!"; - print F "$keys\n"; - close F; - chmod 0664, "/home/repo/j/etc/sshkeys/$name"; - print </home/repo/j/etc/sshkeys/$name" or die "sshkey failed: $!"; + print F "$keys\n"; + close F; + chmod 0664, "/home/repo/j/etc/sshkeys/$name"; + print < User successfuly registered. You (or whoever knows the project password) can assign it to a project now @@ -46,23 +46,23 @@ EOT } if ($cgi->param('name')) { - # submitted, let's see - # FIXME: racy, do a lock - my $name = $repo->wparam('name'); - my $email = $repo->wparam('email'); - my $keys = $cgi->param('keys'); - $name =~ /^[a-zA-Z0-9_+-]+$/ - or $repo->err "Name contains invalid characters."; - (-e "/home/repo/j/etc/sshkeys/$name") - and $repo->err "User with that name already exists."; - $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/ - or $repo->err "Your email sure looks weird...?"; - length($keys) <= 4096 - or $repo->err "The list of keys is more than 4kb. Do you really need that much?"; - unless ($repo->err_check) { - setup_user($name, $email, $keys); - exit; - } + # submitted, let's see + # FIXME: racy, do a lock + my $name = $repo->wparam('name'); + my $email = $repo->wparam('email'); + my $keys = $cgi->param('keys'); + $name =~ /^[a-zA-Z0-9_+-]+$/ + or $repo->err "Name contains invalid characters."; + (-e "/home/repo/j/etc/sshkeys/$name") + and $repo->err "User with that name already exists."; + $email =~ /^[a-zA-Z0-9+._-]+@[a-zA-Z0-9-.]+$/ + or $repo->err "Your email sure looks weird...?"; + length($keys) <= 4096 + or $repo->err "The list of keys is more than 4kb. Do you really need that much?"; + unless ($repo->err_check) { + setup_user($name, $email, $keys); + exit; + } } print <