On Sun, Jan 05, 2003 at 10:50:46AM -0600, Karl Fogel wrote:
> Josef Wolf <jw@raven.inka.de> writes:
> > The question is whether I should post it directly to the list (about
> > 1300 lines) or should I rather mail it to a specific person with
> > commit permissions who will commit it into the repository?
>
> Post directly to the list, or post a URL where people can get the
> code.
OK, I'll attach it to the end of this message.
> It should be reviewed before being put in tools/, if possible.
Oh, I don't think it is ready yet. It surely needs a lot of
modifications. I did not realize that it should be perfectly ready
before it can be added to the repos ;-) As you answered to my original
announcement:
| Share! The best way to shake out bugs is to hand something that
| "mostly" works to a group of eager hackers. :-)
BTW: Somehow symlinked hook-scripts (which are used by this script)
stopped working. Anyone has an idea why this does not work anymore?
The script can be reconfigured to copy instead of symlink. Check the
configuration section.
Here it comes:
--------8<----------------8<----------------8<----------------8<--------
#! /usr/bin/perl -w
my $licence = <<'__LICENCE__'
Author: Josef Wolf, <jw@raven.inka.de> --- January 2003
This program is free software. It is distributed under the terms described
in the COPYING file of the subversion distribution.
Subversion is a tool for revision control.
See http://subversion.tigris.org for more information.
__LICENCE__
;
my $description = <<'__Description__'
With this CGI you can do most of the day-by-day administration of your
subversion server without the need to log into the server. You simply
fire up your favourite www-browser and go ahead.
With this CGI it is also (fairly) simple to set up networked repositories.
Features:
- You can create new repositories. When creating a new repository, you
can choose one of the (previosly defined) templates for this new repos.
The template defines any initial files, directories, property settings
and pre-commit/post-commit definitions (such as access permissions
and commit-email).
- You can add/delete users to the svn-passwd and change their passwords.
Every user can change its own password, of course.
- You can define which users have access (read/write) and which ones have
administration permissions to which repositories.
- The CGI registers itself as [pre|post]-commit-hook. This way it is able
to implement access restrictions, send commit-emails and do
database-backups after every commit.
- You can browse/edit commit-logs in a (IMHO) more convinient way than
tweak-log.cgi does.
- You can quickly browse which changes any commit does to the repository.
- It is already prepared for support of different languages (currently
english and german).
Notes:
- Please protect this script via SSL and some sort of authentication.
Caveats:
- It needs enhancements in security. Currently, I would run it _only_
in secure environments. PLEASE do NOT use it in any untrusted
environments.
- It needs to do more sanity checks.
- It needs to do more taint-cheks on user input.
- It needs to "apachectl graceful" after a new repository is created.
You can use sudo to allow your svnadmin user to run this command.
Alternately, a C-program to do this in a (hopefully) secure manner is
attached below. You should install it with mode=4750, owner=root,
group=svn. The need for this kludge will hopefully disappear as soon as
AuthGroupFile (which seemed to be broken the last time I checked)
will be functional again.
- Currently, this CGI have functionality to _delete_ a repository. This
is only for testing the script. This functionality will disappear at
some day.
- Currently, the cgi is run as the usual httpd-user. This is not good.
It should use Suexec. But Suexec is dangerous, because the current
implementation of the cgi constructs httpd-configs. But the construction
of the httpd-configs can not be disabled, since AuthGroupFile is
not functional yet. ARGHL :-()
TODO:
- create independent configurations for commit-access and commit-email.
- add buttons to insert access/email-configurations in the middle of the
list.
- make it more robust. (sanity checks).
- make more taint-checks.
- cleanup and document the code.
- make it work with AuthGroupFile, so that apache restart will not be
needed anymore.
- remove write-locks and obsolete logs from the database after backup.
- implement an "intelligent" backup scheme, so that replay-logs are
backupped exactly once.
- rewrite to use mod_perl so authentication and speed will be enhanced.
- make the script more robust, so that parallel execution etc/pp will
be handled gracefully.
- create frontend for template creation/maintanance.
- make it safe for Suexec-usage.
- fix bugs.
- accurately log every actions.
- make it more configurable.
- add more hook-functionality (propchange etc)
Installation:
Here is a quick overview on how to install the svn-admin cgi on your
server. Most of the commands given here need to be run as root.
Before you install, you should browse through the configuration section
below and check whether you need some changes. The description here assumes
you have not done any changes to the configuration.
Here is a quick overview of the installation procedure:
- install svn and friends
- create a group and a user for your repository.
- set up sudo or cut+paste, compile and install the apacherestart program.
You can skip this step if you are willing to restart your server
manually every time you create a new repository. Since repository
creation in normally not a very frequent task, it might be OK to
restart the server manually. The decision is up to you.
- setup owner/mode of the work area of the script.
- install the script to its location
- create a passwd file with an initial admin entry.
The following commands (commands preceded by a hash need to be run as root)
should do the trick:
# groupadd svn
# useradd -g svn -d /m/svn -c "Subversion administrator" svn
$ cc -o apacherestart apacherestart.c
# install -g svn -o root -m 4750 -s apacherestart /usr/local/bin
# install -g svn -o svn -m 750 -d /m/svn /m/svn/htcnf /m/svn/cgi
# install -g svn -o svn -m 750 svn-admin /m/svn/cgi
# /usr/local/apache2/bin/htpasswd -c /m/svn/passwd admin
# cp /m/svn/passwd /m/svn/admins
# chmod 640 /m/svn/passwd /m/svn/admins
# chown -R svn.svn /m/svn
# emacs /usr/local/apache2/conf/httpd.conf # configure apache, see below.
# apachectl graceful
$ Netscape http://localhost/svn/cgi/svn-admin
svn-admin will create an "example" template if you do not have a template
with such a name. You might want to investigate it and create your own
templates as you like.
Here is an example, how you should configure apache to serve this script
and its repositories:
Group svn
User svn
LoadModule dav_svn_module modules/mod_dav_svn.so
ServerAdmin you@your.address
ServerName your.company.com
UseCanonicalName Off
<VirtualHost host>
ScriptAlias /svn/cgi/ "/m/svn/cgi/"
Include /m/svn/htcnf/
<Location /svn/cgi>
AuthType Basic
AuthName "Subversion Repository Administration"
AuthUserFile /m/svn/passwd
Require valid-user
</Location>
</VirtualHost>
Here comes the previously mentioned apacherestart program:
cat >apacherestart.c <<__APACHERESTART__
# include <unistd.h>
# include <stdio.h>
# include <stdlib.h>
# include <sys/types.h>
int main (int argc, char *argv[])
{
char *av[] = {"/usr/local/apache2/bin/apachectl", "graceful", NULL};
putenv ("PATH=/sbin:/usr/sbin:/bin:/usr/bin");
unsetenv ("IFS");
unsetenv ("CDPATH");
unsetenv ("ENV");
unsetenv ("BASH_ENV");
setuid(0);
setgid(0);
execv (av[0], av);
}
__APACHERESTART__
__Description__
;
use strict;
use Mail::Send;
use File::Copy;
# Secure the environment
#
umask 0077;
$ENV{PATH} = "/bin:/usr/bin";
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
# german umlauts in commit logs will break svnlook if this is not set.
#
$ENV{RC_LC_COLLATE} = "POSIX";
$ENV{RC_LANG} = 'de_DE@euro';
$ENV{LC_CTYPE} = 'de_DE@euro';
#######################
# Start of Configuration section
#######################
# the directory where the repositories and all additional stuff will reside
#
my $root ="/m/svn";
# the location of the repositories as presented by apache
#
my $reposhtm="/svn/repos";
# The location of the password file
#
my $passfile="$root/passwd";
# This file contains the people who have the right to create new repos
#
my $admins ="$root/admins";
# Into this directory you should install your templates.
#
my $templdir = &create_dir ("$root/templ");
# the svn binaries
#
my $svnadmin="/usr/local/bin/svnadmin";
my $svnlook ="/usr/local/bin/svnlook";
my $svnprog ="/usr/local/bin/svn";
# berkeleyDB binaries
#
my $db_archive="/usr/bin/db_archive";
my $db_recover="/usr/bin/db_recover";
# How to restart apache
#
my $apacherestart = "/usr/local/bin/apacherestart";
# my $apacherestart = "/usr/bin/sudo apachectl graceful";
# Symlinks are used to register the script as hook scripts. If Symlinks
# on hook scripts do not work for you, you might want to change it to copy
# instead... Symlinked hooks worked for me earlier. But for some reason
# they stopped working sometimes about christmas.
#
sub symlink { symlink ($_[0], $_[1]); }
# sub symlink { copy ($_[0], $_[1]); }
##############################
# End of configuration section
##############################
&create_example_template;
# the following directories contain one file or dir per repository.
#
my $htcnfdir = &create_dir ("$root/htcnf"); # apache configs
my $reposdir = &create_dir ("$root/repos"); # the real repositories
my $repconf = &create_dir ("$root/repconf"); # configs of the repositories
# These directories are shared for all repositories
#
my $cgidir = &create_dir ("$root/cgi"); # the location of this script
my $bakdir = &create_dir ("$root/bak"); # repository backups
my $logdir = &create_dir ("$root/log"); # here we put logfiles
my $tmpdir = &create_dir ("$root/tmp"); # here we put tempfiles
chdir $tmpdir or die "$tmpdir: $!";
# Config file keywords
#
my %cnfkw =
(
"ci"=>[qw/regex names access/],
"em"=>[qw/regex access to subject/],
);
# check whether we are a hook script or a CGI and run the appropriate part
# of the script.
#
my ($myname) = $0=~/([a-z_\-]+)$/i;
&log ($myname, @ARGV);
&startcommit(@ARGV) if $myname eq "start-commit";
&precommit (@ARGV) if $myname eq "pre-commit";
&postcommit (@ARGV) if $myname eq "post-commit";
exit 0 unless $myname eq "svn-admin";
##################################
# We are called to run the CGI
##################################
#
use CGI::Pretty;
#use HTML::Entities;
$CGI::POST_MAX = 1024 * 1024;
$CGI::DISABLE_UPLOADS = 1;
my $q = new CGI;
# retrieve some information which we will need all the time
#
my $remote_user = $q->remote_user;
my $repos = $q->param("reposname");
my $urlbase = $q->url(-base=>1);
my $referer = $q->referer();
$referer = $urlbase unless defined $referer; # oups ?!?
#
my @repos = &read_dir ($reposdir); # available repositories
my @tmplts = &read_dir ($templdir); # available templates
#
my %passwd = &read_passwd ($passfile); # basic authentication data
my @admins = &read_groupfile ($admins); # list of global admins
my $admin = &have_access ($remote_user, $admins); # is the user an admin?
my $lang; &init_lang; # internationalization support
# write out the header.
#
print
$q->header,
$q->start_html( #{-style=>'bgcolor: red'},
-BGCOLOR=>"white",
&l('Svn Web Admin')),
$q->h1(&l('Svn Web Admin')),
$q->strong(&l('Current login: '), $remote_user);
#&debug;
# dispatch the flow based on the contents of the form.
#
if (0) {}
elsif (defined $q->param("revlist")) { &rev_list; }
elsif (&isset("reposaccess", &l("Save"))) { &repos_access; }
elsif (&isset("reposemail", &l("Save"))) { &repos_email; }
elsif (&isset("pwchange", &l("New user"))) { &passwd_form(1); }
elsif (&isset("pwchange", &l("Change password"))) { &passwd_form(0); }
elsif (&isset("pwchange", &l("Delete user"))) { &passwd_form(-1); }
elsif (&isset("pwchange", &l("Create"))) { &passwd(1); }
elsif (&isset("pwchange", &l("Change"))) { &passwd(0); }
elsif (&isset("pwchange", &l("Delete"))) { &passwd(-1); }
elsif (&isset("reposadm", &l("Recover"))) { &repos_adm; }
elsif (&isset("reposadm", &l("Access"))) { &repos_adm; }
elsif (&isset("reposperm", &l("Change"))) { &repos_perm; }
elsif (&isset("reposadd", &l("Create"))) { &reposadd(1); }
elsif (&isset("reposadd", &l("Delete"))) { &reposadd(0); }
else {
my @revs = grep (s/^reposlog-([0-9]+)$/$1/, $q->param);
my @diff = grep (s/^reposdiff-([0-9]+)$/$1/, $q->param);
if (0) {
} elsif ($#revs>=0) {
for my $r (@revs) {
&repos_log ($r);
}
} elsif ($#diff>=0) {
for my $r (@diff) {
&repos_diff ($r);
}
} else {
&main_form;
}
}
print $q->end_html;
exit 0;
sub main_form {
&start_form;
print $q->h2(&l("User administration"));
print $q->submit(-name=>"pwchange",-value=>&l("Change password"));
if ($admin) {
print $q->submit(-name=>"pwchange",-value=>&l("New user"));
print $q->submit(-name=>"pwchange",-value=>&l("Delete user"));
print $q->hr;
print $q->h2(&l("Create repository"));
print &l("Name:"), $q->textfield("reposname");
print &l("Template:"), $q->popup_menu("template", [sort @tmplts]);
print $q->submit(-name=>"reposadd",-value=>&l("Create"));
print $q->submit(-name=>"reposadd",-value=>&l("Delete"));
# print $q->br;
}
print $q->hr;
print $q->h2(&l("Repository administration"));
print "<table><tr><td>\n";
foreach my $r (sort @repos) {
my $isadmin = $admin || &have_access($remote_user,"$repconf/$r/admin");
my $isuser = $admin || &have_access($remote_user,"$repconf/$r/group");
print "<tr><td>\n";
if ($isuser || $isadmin) {
print $q->a({-href=>"$urlbase$reposhtm/$r/"}, $r);
} else {
print $r;
}
if ($isadmin) {
print "</td><td>\n";
print $q->a({-href=>$q->url .
"?reposname=$r&lang=$lang&reposadm=" .
(&l("Access"))[0]}, &l("Configure"));
print "</td></tr>\n";
}
# print $q->br;
}
print "</td></tr></table>\n";
print $q->hr;
&end_form;
}
sub repos_log {
my ($rev) = @_;
my $log = $q->param("log-$rev");
$log =~ s/\n+$//m;
return unless defined ($repos=&check_access($repos, -wantadm=>1));
my $tmp="svn-log-$$";
open (T, ">$tmp") || die "$tmp: $!";
print T $log;
close T || die "$tmp: $!";
&x("$svnadmin setlog $reposdir/$repos -r $rev $tmp");
unlink $tmp;
print $q->h1(sprintf &l('Repository %s log changed for revision %s'), $repos, $rev);
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
}
sub repos_diff {
my ($rev) = @_;
return unless defined ($repos=&check_access($repos));
print $q->h1(sprintf &l('Repository %s diff for revision %s'), $repos,$rev);
&x("$svnlook diff $reposdir/$repos -r $rev");
# print map { "$_<br>\n"; } (@diff);
}
sub repos_perm {
return unless defined ($repos=&check_access($repos, -wantadm=>1));
my @raccess = $q->param("raccess");
my @radmin = $q->param("radmin");
if ($#radmin<0) {
print $q->h1(&l("There must be at least one admin."));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
if ($#raccess<0) {
print $q->h1(&l("There must be at least one user."));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
&write_groupfile ("$repconf/$repos/group", @raccess);
&write_groupfile ("$repconf/$repos/admin", @radmin);
print $q->h1(sprintf &l('Permissions changed for repository %s'), $repos);
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
}
sub rev_list {
my $revlist = $q->param("revlist");
my ($first, $last);
if ($revlist =~ /^(\d+)$/) {
$first=$last=$1;
} else {
($first, $last) = $revlist =~ /^(\d+)-(\d+)$/;
}
return unless defined ($repos=&check_access($repos, -wantadm=>1));
if (!defined $first || !defined $last) {
print $q->h1(&l("Illegal revision range."));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
&start_form;
print $q->hidden(-name=>"reposname", -value=>$repos);
for my $rev ($first..$last) {
my $ret = `$svnlook info $reposdir/$repos -r $rev`;
my ($author, $date, $len, @log) = split (/\n/, $ret);
print "Rev $rev $author $date<br>";
print "<table border=0><tr><td>\n";
print $q->textarea(-name=>"log-$rev", -rows=>$#log+2, -columns=>80,
-default=>join("", @log));#, $q->br;
print "</td><td>\n";
print $q->submit(-name=>"reposlog-$rev", -value=>&l("Change"));
print $q->submit(-name=>"reposdiff-$rev", -value=>&l("Diff"));
print "</td></tr></table><hr>\n";
}
&end_form;
}
sub repos_access {
my @kw = qw/regex names access/;
my $cicnf = &parse_cicnf ("ci");
if (defined $cicnf) {
&write_cicnf ("ci", "$repconf/$repos/cicnf", $cicnf, "Checkin");
}
}
sub repos_email {
my @kw = qw/regex access to subject/;
my $emcnf = &parse_cicnf ("em");
if (defined $emcnf) {
&write_cicnf ("em", "$repconf/$repos/emcnf", $emcnf, "eMail");
}
}
sub repos_adm {
my @admins = &read_groupfile("$repconf/$repos/admin");
my @users = &read_groupfile("$repconf/$repos/group");
return unless defined ($repos=&check_access($repos, -wantadm=>1));
&start_form;
print $q->hidden(-name=>"reposname", -value=>$repos);
print "<table border>\n";
print $q->th([&l("Admin"), &l("Access")]);
print $q->Tr({-align=>'left', -valign=>'center'},
[ $q->td ([
$q->checkbox_group(-name=>"radmin", -columns=>1,
-default=>[@admins],
-values=>[keys %passwd] ),
$q->checkbox_group(-name=>"raccess",-columns=>1,
-default=>[@users],
-values=>[keys %passwd] )
]
)]);
print "</table>\n";
print $q->submit(-name=>"reposperm",-value=>&l("Change"));
print $q->hr, $q->h1(&l("Checkin-settings"));
print "<table border=0><tr>\n";
print $q->th([&l("RegEx"),&l("Name"),&l("Access")]);
print "</tr>";
my @cicnf=@{&read_cicnf("ci", "$repconf/$repos/cicnf")};
for my $c (0..$#cicnf) {
print "<tr>\n";
print $q->td ($q->textfield(-name=>"ci-regex-$c",
-default=>$cicnf[$c]{"regex"}));
print $q->td ($q->textfield(-name=>"ci-names-$c",
-default=>$cicnf[$c]{"names"}));
my (@access) = map { &l($_) } (split (/\s+/, $cicnf[$c]{"access"}));
print $q->td ($q->checkbox_group(-name=>"ci-access-$c", -rows=>1,
-default=>[@access],
-values=>[&l("Create"),
&l("Change"),
&l("Delete")]));
print "</tr>\n";
}
print "</table>\n";
print $q->submit(-name=>"reposaccess",-value=>&l("Save"));
print $q->hr, $q->h1(&l("eMail-settings"));
print "<table border=0><tr>\n";
print $q->th([&l("RegEx"),&l("Access"),&l("To"),&l("Subject")]);
print "</tr>";
my @emcnf=@{&read_cicnf("em", "$repconf/$repos/emcnf")};
for my $c (0..$#emcnf) {
print "<tr>\n";
print $q->td ($q->textfield(-name=>"em-regex-$c",
-default=>$emcnf[$c]{"regex"}));
my (@access) = map { &l($_) } (split (/\s+/, $emcnf[$c]{"access"}));
print $q->td ($q->checkbox_group(-name=>"em-access-$c", -rows=>1,
-default=>[@access],
-values=>[&l("Create"),
&l("Change"),
&l("Delete")]));
print $q->td ($q->textfield(-name=>"em-to-$c",
-default=>$emcnf[$c]{"to"}));
print $q->td ($q->textfield(-name=>"em-subject-$c",
-default=>$emcnf[$c]{"subject"}));
print "</tr>\n";
}
print "</table>\n";
print $q->submit(-name=>"reposemail",-value=>&l("Save"));
print $q->hr, $q->h1("revisions");
my $youngest = `$svnlook youngest $reposdir/$repos`; chomp $youngest;
$youngest=~/^(.*)$/; $youngest=$1;
my @revs = (1..$youngest);
my ($lcnt, @list, @lists, @rows, @columns) = (9);
do {
@list = splice (@revs, 0, $lcnt);
if ($#list > 0) {
push (@lists, "$list[0]-$list[$#list]");
} else {
push (@lists, $list[0]);
}
$lcnt=10;
} while ($#revs>=0);
print "<table border=0>\n";
do {
my $url = $q->url . "?lang=$lang&reposname=$repos";
my @list = splice (@lists, 0, 10);
foreach my $l (@list) {
$l = $q->a({-href=>"$url&revlist=$l"}, $l);
}
print $q->Tr({-align=>'right', -valign=>'center'},
[ $q->td ([ @list ])
]);
} while ($#lists>=0);
print "</table>\n";
print $q->hr, $q->h1(&l("Miscellaneous"));
print $q->submit(-name=>"reposadm", -value=>&l("Recover"));
&end_form;
}
sub user_checkbox {
my ($prefix, $u, $ary) = @_;
return $q->checkbox("$prefix-$u", $ary->{$u}, 1, "");
}
sub reposadd {
my ($action) = @_;
my $templ = $q->param("template");
my $frepos="file://$reposdir/$repos";
my $wc="svn-create-$$";
return unless defined ($repos=&check_access($repos, -create=>$action));
if (!$action) {
# &x("rm -rf '$repconf/$repos' '$reposdir/$repos' '$htcnfdir/$repos'");
## $bakdir/$repos`;
# print $q->h1(sprintf &l('Repository %s deleted.'), $repos);
# &x($apacherestart);
print $q->h1(sprintf &l('Repository deletion disabled.'), $repos);
print qq!<meta http-equiv="refresh" content="20; URL=$referer">!;
return;
}
&create_dir ("$repconf/$repos");
&write_groupfile ("$repconf/$repos/group", $remote_user);
&write_groupfile ("$repconf/$repos/admin", $remote_user);
&x("$svnadmin create $reposdir/$repos");
&symlink ("$cgidir/$myname", "$reposdir/$repos/hooks/start-commit");
&symlink ("$cgidir/$myname", "$reposdir/$repos/hooks/pre-commit");
&symlink ("$cgidir/$myname", "$reposdir/$repos/hooks/post-commit");
&x("$svnprog --username $remote_user import -m 'first revision' $frepos $templdir/$templ/contents");
if (open (P, "$templdir/$templ/properties")) {
&x("rm -fr $wc; $svnprog --username $remote_user co $frepos $wc");
while (my $l = <P>) {
chomp $l; $l=~s/\015//g;
my ($wctarget, $kw, $val) = split (/\s+/, $l, 3);
$wctarget =~ s/^\///;
&x("cd $wc; $svnprog propset $kw $val ./$wctarget");
# &x("$svnprog propset $kw $val $frepos/$wctarget");
}
&x("cd $wc; $svnprog --username $remote_user ci -m 'Properties set.'");
&x("rm -fr $wc");
close P;
}
copy ("$templdir/$templ/cicnf", "$repconf/$repos/cicnf");
copy ("$templdir/$templ/emcnf", "$repconf/$repos/emcnf");
if (0) {
open (H, ">$reposdir/$repos/.htaccess");
print H qq!AuthType Basic\n!;
print H qq!AuthName "Subversion Repository $repos"\n!;
print H qq!AuthUserFile $passfile\n!;
print H qq!AuthGroupFile $repconf/$repos/group\n!;
print H qq!Require Group $repos\n!;
close H;
} else {
open (C, ">$htcnfdir/$repos");
print C qq!<Location /svn/repos/$repos>\n!;
print C qq! DAV svn\n!;
print C qq! SVNPath /m/svn/repos/$repos\n!;
# print C qq! SetOutputFilter DEFLATE\n!;
# print C qq!</Location>\n!;
# print C qq!<Directory /m/svn/repos/$repos>\n!;
print C qq! AuthType Basic\n!;
print C qq! AuthName "Subversion Repository $repos"\n!;
# print C qq! AuthUserFile $passfile\n!;
# print C qq! AuthGroupFile $repconf/$repos/group\n!;
print C qq! AuthUserFile $repconf/$repos/group\n!;
# print C qq! Require Group $repos\n!;
print C qq! Require valid-user\n!;
print C qq!</Location>\n!;
# print C qq!</Directory>\n!;
close C;
}
print $q->h1(sprintf &l('Repository %s created.'), $repos);
&x ($apacherestart);
print qq!<meta http-equiv="refresh" content="20; URL=$referer">!;
}
sub passwd_form {
my ($new_user) = @_;
my $label;
&start_form;
print $q->table({-border=>undef},
$q->Tr({-align=>"left",-valign=>"center"},
[
$admin ? $q->td ([&l("Username"), $q->textfield("user")])
: $q->td ([&l("Old password"), $q->password_field("pass")]),
$new_user>=0 ? $q->td ([&l("New password"), $q->password_field("pass1")]) : "",
$new_user>=0 ? $q->td ([&l("New password"), $q->password_field("pass2")]) : "",
]
)
);
if (0) {}
elsif ($new_user== 1) { $label = &l("Create"); }
elsif ($new_user== 0) { $label = &l("Change"); }
elsif ($new_user==-1) { $label = &l("Delete"); }
print $q->submit(-name=>"pwchange",-value=>$label);
&end_form;
}
sub passwd {
my ($new_user) = @_;
my $oldpw = $q->param("pass");
my $user = $q->param("user");
$user = $remote_user unless defined $user;
if ($user !~ /^[a-z0-9_\-]+$/i) {
print $q->h1(&l("Illegal user name."));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
if ($q->param("pass1") ne $q->param("pass2")) {
print $q->h1(&l("New passwords do not match."));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
if (!$admin) {
if ($new_user!=0 || $remote_user ne $user) {
print $q->h1(&l("Permission denied"));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
if (crypt($oldpw, $passwd{$user}) ne $passwd{$user}) {
print $q->h1("Old password does not match.");
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
return;
}
}
my $salt = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
if ($new_user==-1) {
delete $passwd{$user};
} else {
$passwd{$user} = crypt ($q->param("pass1"), $salt);
}
&write_passwd ($passfile, keys %passwd);
foreach my $r (@repos) {
&update_groupfile ("$repconf/$r/group");
&update_groupfile ("$repconf/$r/admin");
}
if (0) {}
elsif ($new_user== 1) { print $q->h1(sprintf &l('User %s created.'), $user); }
elsif ($new_user== 0) { print $q->h1(sprintf &l('Password for user %s changed.'), $user); }
elsif ($new_user==-1) { print $q->h1(sprintf &l('User %s deleted.'), $user); }
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
}
# To implement access restrictions, the following files are used:
#
# $passfile is the primary mapping from user names to passwords.
# $admins contains the users with permissions to create new
# repositories or to manipulate configurations of
# _all_ existing repositories. The people listed in
# this file are the "superusers" of all the
# repositories managed by this script.
# $repconf/$repos/admin This are the users which have premission to change
# configuration for this specific repository.
# $repconf/$repos/group This are the ordinary users of this specific
# repository.
#
# Since the AuthGroupFile handling is broken at the time of this writing, the
# password handling is implemented as a cludge: The password entries are
# mirrored from $passfile to the other files, so they can be handed as
# AuthUserFile to apache
sub read_passwd {
my ($file) = @_;
my %ary;
$file = $passfile unless defined $file;
open (P, $file) || die "$file: $!";
while (my $l=<P>) {
chomp $l;
my ($u, $p) = split (":", $l, 2);
next unless defined $u;
$ary{$u}=$p;
}
close P;
return %ary;
}
sub write_passwd {
my ($fn, @members) = @_;
open (P, ">$fn.tmp") || die "$fn: $!";
foreach my $m (@members) {
print P "$m:$passwd{$m}\n" if exists $passwd{$m};
}
close P || die "$fn: $!";
rename "$fn.tmp", $fn;
}
sub write_groupfile {
&write_passwd (@_);
}
sub read_groupfile {
my ($fn) = @_;
my %users = &read_passwd ($fn);
return keys %users;
}
sub update_groupfile {
my ($fn) = @_;
&write_groupfile ($fn, &read_groupfile ($fn));
}
my %access;
sub have_access {
my ($user, $grp_file) = @_;
if (!exists $access{$grp_file}) {
$access{$grp_file} = { map { $_=>1; } &read_groupfile($grp_file) };
}
return 1 if exists($access{$grp_file}{$user}) && $access{$grp_file}{$user};
return 0;
}
sub check_access {
my ($repos, %opts) = @_;
my ($err);
my $nohtml = exists $opts{"-nohtml"} && $opts{"-nohtml"} ? 1 : 0;
$repos =~ s!^.*/!!g; # remove path
if ($repos =~ /^([a-z0-9_\-]+)$/i) {
$repos = $1;
my $wantadm = exists $opts{"-wantadm"} && $opts{"-wantadm"} ? 1 : 0;
my $create = exists $opts{"-create"} && $opts{"-create"} ? 1 : 0;
my $exist = -e "$reposdir/$repos" ? 1 : 0;
$err = "Repository already exists." if $create && $exist;
$err = "No such repository." unless $create || $exist;
if (!$admin &&
!&have_access($remote_user, "$repconf/$repos/admin") &&
($wantadm ||
!&have_access($remote_user, "$repconf/$repos/group"))) {
$err = "Permission denied";
}
} else {
$err = "Illegal repository name.";
}
if (defined $err) {
unless ($nohtml) {
print $q->h1(&l($err));
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
}
return undef;
}
print $q->h1(sprintf &l('Current repository: %s'), $repos) unless $nohtml;
return $repos;
}
# Return all acceptable files name within a directory
#
sub read_dir {
my ($dn) = @_;
opendir (DIR, $dn);
my @files = grep { /^[a-z0-9_\-]+$/i } readdir (DIR);
closedir DIR;
return @files;
}
# Check whether a CGI-Parameter is set to a specific value
#
sub isset {
my ($par, $val) = @_;
my $v = $q->param("$par");
return 1 if defined $v && $v eq $val;
return 0;
}
# $q->td (["Test ", $q->scrolling_list(-name=>"cmd1", -size=>4, -multiple=>0,
# -values=>[qw/aaa bbb BBB ccc CCC/])]),
# print $q->submit(-name=>"pwchange",-value=>"Change Password");
# print $q->blockquote($q->em("test"),"test"), "test";
sub debug {
# foreach my $e (keys %ENV) {
# print "$e: $ENV{$e}<br>\n";
# }
foreach my $k ($q->param) {
print "$k : ", $q->param($k), "<br>\n";
}
# foreach my $a (["admins", \@admins],["radmin", \@radmin],["raccess",\@raccess]) {
# print "$a->[0]: ", join (",", @{$a->[1]}), "<br>\n";
# }
# print "$referer ";
# print $q->referer(), " ";
print $q->auth_type, " ", $remote_user, " ";
print $q->user_name, " admin:$admin<br><hr>\n";
}
sub x {
print "<hr>", join ("<br>", @_, "\n") if defined $q;;
&log (@_);
my ($ret, @out) = &X (@_);
print $q->h3(join ("<br>", @out, "\n")) if defined $q;;
($ret, @out);
}
sub X {
my ($pid, @output);
return (-1, "$0: can't fork: $!") unless defined ($pid = open(KID, '-|'));
unless ($pid) {
open (STDERR, ">&STDOUT") or return (-1, "$0: can't dup STDOUT: $!");
exec (@_) or return (-1, "$0: can't exec '@_': $!");
}
while (my $l=<KID>) {
chomp $l;
push(@output, $l);
}
close(KID);
return ($?, @output)
}
sub read_cicnf {
my ($prefix, $file) = @_;
my @cicnf;
my $n = 0;
my $curary = {};
if (open (C, $file)) {
while (my $l=<C>) {
chomp $l;
$l=~s/^\s+//;
$l=~s/\s+$//;
next if $l =~ /^\#/;
if ($l =~ /^(\w+)\s*[=:]\s*(.*)/) {
if ($1 eq "regex") {
$curary = {};
$cicnf[$n++] = $curary;
}
$curary->{$1} = $2;
}
}
close C;
}
$cicnf[$n++] = {map {$_=>"";}(@{$cnfkw{$prefix}})};
return \@cicnf;
}
sub parse_cicnf {
my ($prefix) = @_;
my (@ary);
my ($an) = 0;
my (@keywords) = @{$cnfkw{$prefix}};
return unless defined ($repos=&check_access($repos, -wantadm=>1));
BLOCK: for (my $n=0; defined ($q->param("$prefix-$keywords[0]-$n")); $n++) {
foreach my $k (@keywords) {
my $v=$q->param("$prefix-$k-$n");
$v="" unless defined $v;
if ($k eq "regex") {
$v =~ s/^\s+//;
$v =~ s/\s+$//;
next BLOCK if $v eq "";
} elsif ($k eq "access") {
my @access;
for my $ac ($q->param("$prefix-$k-$n")) {
for my $kw (qw/Create Change Delete/) {
push (@access, $kw), last if $ac eq &l($kw);
}
}
$v=join(" ", @access);
}
$ary[$an]{$k} = $v;
}
$an++;
}
return \@ary;
}
sub write_cicnf {
my ($prefix, $fn, $ary, $type) = @_;
if (open (C, ">$fn.tmp")) {
for my $n (0..$#$ary) {
for my $k (@{$cnfkw{$prefix}}) {
print C "$k: $ary->[$n]{$k}\n";
}
print C "\n";
}
if (close C && rename ("$fn.tmp", "$fn")) {
print $q->h1(sprintf &l($type.'-setting for repository %s saved.'), $repos);
} else {
print $q->h1(sprintf &l('Error: %s.tmp: %s'), $fn, $!);
}
} else {
print $q->h1(sprintf &l('Error: %s.tmp: %s'), $fn, $!);
}
print qq!<meta http-equiv="refresh" content="5; URL=$referer">!;
}
##############
# Hook scripts
##############
sub startcommit {
my ($repos, $user) = @_;
# Why should we need to do anything here?
&log ("startcommit", @_);
$remote_user = $user;
unless (defined($repos=&check_access($repos,-nohtml=>1))) {
die "$repos: Permission denied";
}
}
sub do_cicnf {
my ($repos_path, $type, $txn) = @_;
my ($err, @mails);
my (%adds, %dels, %mods);
my ($as, $author, $date, $dummy, @log) =
&x ("$svnlook info $repos_path $type $txn");
my ($cs, @changed) = &x ("$svnlook changed $repos_path $type $txn");
chomp @changed;
chomp @log;
$remote_user = $author;
unless (defined($repos=&check_access($repos_path,-nohtml=>1))) {
die "$repos: Permission denied";
}
# checkin permissions
#
my @cicnf=@{&read_cicnf("ci", "$repconf/$repos/cicnf")};
my @emcnf=@{&read_cicnf("em", "$repconf/$repos/emcnf")};
&log("checking checkin configurations");
foreach my $p (@changed) {
&log("change: $p");
my ($mod, $path) = $p =~ /^(..)\s+(.*)/;
for my $ary (@cicnf) {
&log("cicnf:", map{"$_: $ary->{$_},"}(keys %$ary));
if ($ary->{"names"} ne "") {
my $valid=0;
foreach my $u (split (/[,\s]+/, $ary->{"names"})) {
$valid = 1 if $u eq $author;
}
next unless $valid;
}
my $ac = $ary->{"access"};
my $re = $ary->{"regex"};
$re =~ s+^\^/+^+;
next unless $path=~/$re/;
$adds{$path}=1 if $mod=~/A/;
$dels{$path}=1 if $mod=~/D/;
$mods{$path}=1 if $mod=~/U/;
$err="$repos/$path: Cant create $path $ac" if $mod=~/A/ && $ac!~/Create/;
$err="$repos/$path: Cant delete $path $ac" if $mod=~/D/ && $ac!~/Delete/;
$err="$repos/$path: Cant change $path $ac" if $mod=~/U/ && $ac!~/Change/;
}
for my $ary (@emcnf) {
&log("emcnf: $ary->{'regex'}");
my $ac = $ary->{"access"};
my $re = $ary->{"regex"};
$re =~ s+^\^/+^+;
next unless $path=~/$re/;
push(@mails, $ary);
}
}
&log($err), die $err if defined $err;
return if $type eq "-t";
# Backup the repos. For now we choose the paranoia way to never delete any
# logs.
#
my $target = sprintf ("$bakdir/$repos-%08d", $txn);
&x ("cp -a $repos_path '$target'");
my ($s, @logs) = &x ("$db_archive -l -h '$repos_path/db'");
chomp @logs;
foreach my $l (@logs) {
&x ("cp '$repos_path/db/$l' '$target/db'");
}
&x ("tar czvf '$target.tgz' '$target' && rm -r '$target'");
# send the commit emails.
#
my ($ds,@diff)=&x("$svnlook diff $repos_path $type $txn --no-diff-on-delete");
my (@adds) = keys %adds;
my (@dels) = keys %dels;
my (@mods) = keys %mods;
foreach my $m (@mails) {
my ($mail) = new Mail::Send;
$mail->to($m->{"to"});
$mail->subject($m->{"subject"});
# $mail->from("reposadmin\@kh1a927d.khe.siemens.de");
my $mfh = $mail->open;
print $mfh "Author: $author\n";
print $mfh "Date: $date\n";
print $mfh "New Revision: $txn\n";
print $mfh "\n";
print $mfh "Added:\n", map { " $_\n"; } (@adds) if $#adds>=0;
print $mfh "Removed:\n", map { " $_\n"; } (@dels) if $#dels>=0;
print $mfh "Modified:\n", map { " $_\n"; } (@mods) if $#mods>=0;
print $mfh "Log:\n", map { "$_\n"; } (@log), "\n";
print $mfh map {"$_\n";} (@diff);
$mfh->close;
# &log ("postcommit", @rcpts);
# send emails
# log-commit.py haeh?
# no exit code
}
}
sub precommit {
my ($repos_path, $txn) = @_;
&do_cicnf ($repos_path, "-t", $txn);
# sanity checks on log messages
}
# post-revprop-change?
sub postcommit {
my ($repos_path, $revnum) = @_;
&do_cicnf ($repos_path, "-r", $revnum);
}
sub log {
open (LOG, ">>$logdir/log");
print LOG join (" ", @_), "\n";
close LOG;
}
# create a directory and return its name.
#
sub create_dir {
my ($dir) = @_;
mkdir ($dir, 0750) unless -d $dir;
return $dir;
}
# create an example template if it doesn't exist yet and populate it with
# example contents.
#
sub create_example_template {
return if -e "$templdir/example";
&create_dir ("$templdir/example");
&create_dir ("$templdir/example/contents");
&create_dir ("$templdir/example/contents/tags");
&create_dir ("$templdir/example/contents/releases");
&create_dir ("$templdir/example/contents/branches");
&create_dir ("$templdir/example/contents/imports");
my $trunk = &create_dir ("$templdir/example/contents/trunk");
open (G, ">$trunk/getversion.pl") or return;
print G <<'__GETVER__'
#! /usr/bin/perl -w
use strict;
my $vers = '$HeadURL$';
my $y = '$LastChangedDate$';
if ($vers=~m!/trunk/!) {
print "WARNING: you are using an inofficial snapshot!\n";
} elsif ($vers=~m!/branches/([^/]+)!) {
print "WARNING: Do you really want to be on HEAD of $1?\n";
} elsif ($vers=~m!/releases/([^/]+)!) {
print "You use official version $1, that's OK!\n";
} elsif ($vers=~m!/tags/([^/]+)!) {
print "You use version $1, that's OK!\n";
}
__GETVER__
;
close G;
open (P, ">$templdir/example/properties") or return;
print P <<'__PROP__'
/trunk/getversion.pl svn:eol-style "native"
/trunk/getversion.pl svn:keywords "HeadURL LastChangedDate"
/trunk/getversion.pl svn:executable ""
/ svn:ignore "*.obj *.o *~"
__PROP__
;
close P;
open (C, ">$templdir/example/cicnf") or return;
print C <<'__CICNF__'
# This file controls the access permissions for commits. It contains a list of
# blocks which are processed in the given order. Each block starts out with a
# regular expression. A block is applicable only on paths which are matched by
# its regex. The "names:" entries define for which users this block is to be
# applied. An empty "names:" entry have the meaning "all users".
# Released versions can never be deleted or modified.
#
regex: ^/releases
names:
access: Create
# Tagged versions cannot be modified.
#
regex: ^/tags
names:
access: Create Delete
# Branches are supposed to be changed.
#
regex: ^/branches
names:
access: Create Change Delete
# Trunk will be changed, too.
#
regex: ^/trunk
names:
access: Create Change Delete
# No more modifications on the top level are accepted
#
regex: ^/[^/]+$
names:
access:
__CICNF__
;
close C;
open (C, ">$templdir/example/emcnf") or return;
print C <<'__EMCNF__'
# This file controls how commit emails are created.
# Let customers know that a new version has been released
#
regex: ^/releases
access: Create
to: customers@your.company.com
subject: New version of FOOBAR released.
# Let betatesters know that new work is waiting for them
#
regex: ^/tags
access: Create
to: betatesters@your.company.com
subject: Tag FOO created
regex: ^/branches
access: Create
to: developers@your.company.com
subject: Branch FOO created
regex: ^/branches
access: Delete
to: developers@your.company.com
subject: Branch FOO deleted
regex: ^/branches
access: Change
to: developers@your.company.com
subject: Branch FOO changed
regex: ^/trunk
access: Create Change Delete
to: developers@your.company.com
subject: Commit to FOOBAR
__EMCNF__
;
close C;
}
# Internationalization
#
my (%lang, %avail);
sub l {
my @ret;
if (defined $lang && exists $lang{$lang}) {
foreach my $i ($#_) {
my $orig = $_[$i];
my $trans = $lang{$lang}{$orig};
$ret[$i] = defined $trans ? $trans : $orig;
}
} else {
@ret = @_;
}
return $#ret ? @ret : join(" ", @ret);
}
sub init_lang {
# set defaults
#
$avail{"en"} = "English";
my $l = $q->param("lang");
$l = "en" unless defined $l;
##############
# translations
##############
# German
#
$avail{"de"} = "Deutsch";
$lang{"de"} = {
"Access" => "Zugriff",
"Admin" => "Admin",
"Change" => "Ändern",
"Change password" => "Passwort ändern",
'Checkin-setting for repository %s saved.' => 'Checkin-Einstellungen für Repository %s gespeichert.',
"Checkin-settings" => "Checkin-Einstellungen",
"Configure" => "Konfigurieren",
"Create repository" => "Neue Repository anlegen",
"Create" => "Anlegen",
"Current login: " => "Aktueller Login: ",
'Current repository: %s' => 'Aktuelle Repository: %s',
"Delete" => "Löschen",
"Delete user" => "Benutzer löschen",
"Diff" => "Diff",
"eMail" => "eMail",
"eMail-settings" => "eMail-Einstellungen",
'eMail-setting for repository %s saved.' => 'eMail-Einstellungen für Repository %s gespeichert.',
'Error: %s.tmp: %s' => 'Fehler: %s.tmp: %s',
"Illegal repository name." => "Repository-Name unzulässig.",
"Illegal revision range." => "Revision-Bereichsangabe unzulässig.",
"Illegal user name." => "Ungültiger Benutzername.",
"Miscellaneous" => "Verschiedenes",
"Name:" => "Name:",
"Name" => "Name",
"New password" => "Neues Passwort",
"New passwords do not match." => "Neue Passwörter stimmen nicht überein.",
"New user" => "Neuer Benutzer",
"Old password" => "Altes Passwort",
"Old password does not match." => "Altes Passwort falsch.",
'Password for user %s changed.' => 'Benutzer %s Passwort geändert.',
"Permission denied" => "Keine Berechtigung.",
'Permissions changed for repository %s' => 'Repository %s Berechtigungen geändert.',
"Recover" => "Wiederherstellung",
"RegEx" => "RegEx",
"Repository administration" => "Repository verwalten",
"Repository already exists." => "Repository existiert bereits.",
'Repository %s created.' => 'Repository %s erstellt.',
'Repository %s deleted.' => 'Repository %s gelöscht.',
'Repository %s log changed for revision %s.' => 'Repository %s Log %s geaendert.',
"Save" => "Speichern",
"Svn Web Admin" => "Svn Web Administration",
"Template:" => "Template:",
"There must be at least one admin." => "Ein Admin muss verbleiben.",
"There must be at least one user." => "Ein Benutzer muss verbleiben.",
"Username" => "Benutzername",
"User administration" => "Benutzerverwaltung",
'User %s created.' => 'Benutzer %s angelegt.',
'User %s deleted.' => 'Benutzer %s gelöscht.',
};
# process button press from user
#
my $sl;
if (defined ($sl=$q->param("setlang"))) {
for my $k (keys %avail) {
$l = $k, last if $sl eq $avail{$k};
}
}
# taint the value
#
$l =~ /^([a-z][a-z])/;
$lang = lc $1;
$q->param(-name=>"lang", -value=>$lang);
}
sub lang_select {
print $q->hr;
print $q->hidden(-name=>"lang", -value=>$lang);
for my $l (sort keys %avail) {
print $q->submit(-name=>"setlang",-value=>$avail{$l});
}
print $q->hr;
}
sub start_form {
print $q->start_form;
&lang_select;
}
sub end_form {
print $q->end_form;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@subversion.tigris.org
For additional commands, e-mail: dev-help@subversion.tigris.org
Received on Mon Jan 6 22:59:39 2003