From 5bbf9627d097d85e2bfb98a45aa28efa9a60681d Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sat, 12 Jul 2014 11:21:39 +0100 Subject: [PATCH 1/1] Initial revision. --- adduser | 612 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ adduser.conf | 21 ++ userv/rewrite | 10 + userv/set | 10 + 4 files changed, 653 insertions(+) create mode 100755 adduser create mode 100644 adduser.conf create mode 100644 userv/rewrite create mode 100644 userv/set diff --git a/adduser b/adduser new file mode 100755 index 0000000..465eef9 --- /dev/null +++ b/adduser @@ -0,0 +1,612 @@ +#! /usr/bin/perl + +use autodie qw(:all); + +use File::Find; +use File::Path qw(make_path remove_tree); +use POSIX qw(:errno_h); + +use Data::Dumper; + +## Set up Gitolite's various things. +BEGIN { + die "GL_RC unset" unless exists $ENV{GL_RC}; + die "GL_BINDIR unset" unless exists $ENV{GL_BINDIR}; + unshift @INC, $ENV{GL_BINDIR}; +} +use gitolite_rc; +use gitolite; + +###-------------------------------------------------------------------------- +### Utility functions. + +sub indent_length ($) { + my ($s) = @_; + ## Return the width of the initial indent of S, in columns, counting tabs + ## as an indent to the next multiple of eight. + + my ($ind) = $s =~ /^(\s+)/; + my $n = length $ind; + my $x = 0; + + for (my $i = 0; $i < $n; $i++) { + if (substr($ind, $i, 1) eq "\t") { $x = ($x + 8)&~7; } + else { $x++; } + } + return $x; +} + +sub trim_indent ($$) { + my ($s, $n) = @_; + ## Return the string S, minus initial characters as far as (but in no case + ## exceeding) column N, counting tabs as an indent to the next multiple of + ## eight. + + my $x = 0; + my ($y, $i); + + for ($i = 0; $i < length $s; $i++) { + if (substr($s, $i, 1) eq "\t") { $y = ($x + 8)&~7; } + else { $y = $x + 1; } + last if $y >= $n; + $x = $y; + } + return substr $s, $y == $n ? $i + 1 : $i; +} + +sub arg (\@$) { + my ($a, $what) = @_; + ## Fetch the next argument from A; report an error that we don't have WHAT + ## if we run out. + + die "missing $what\n" unless @$a; + return shift @$a; +} + +###-------------------------------------------------------------------------- +### Configuration file. + +sub commit_confkey ($$@) { + my ($h, $k, @lines) = @_; + ## Store the configuration value LINES in the hash H, under key K. + ## + ## The longest common sequence of whitespace is trimmed from the LINES (as + ## measured using `indent_length'), and then they're concatenated with + ## newlines between. + + return unless defined $k; + + shift @lines if $lines[0] eq ""; + pop @lines while @lines && $lines[-1] eq ""; + + my $ind = undef; + for my $l (@lines) { + next if $l =~ /^\s*$/; + my $n = indent_length $l; + if (!defined($ind) || $n < $ind) { $ind = $n; } + } + $h->{$k} = join "\n", map { trim_indent $_, $ind } @lines; +} + +sub read_config ($) { + my ($conf) = @_; + ## Read configuration from the file CONF, and return a two-level hash + ## %conf{GROUP}{KEY} representing it. + + my %c; + + open my $fh, "<", $conf; + my $line = <$fh>; + my $n = 0; + my ($h, $k); + my @acc; + + $h = \%{$c{""}}; + while (defined $line) { + chomp $line; $n++; + if ($line =~ /^([;\#])/) { } + elsif ($line =~ /^\s*\[\s*([-_:\w]+)\s*\]\s*$/) { + commit_confkey $h, $k, @acc; + $h = \%{$c{$1}}; + undef $k; + } elsif ($line =~ /^\s/) { + defined $k or die "$conf:$n: no line to continue\n"; + push @acc, $line; + } elsif ($line =~ /^\s*$/) { + push @acc, $line if defined $k; + } elsif ($line =~ /^([-\/.%\w]+)\s*[:=]\s*(\S.*|)$/) { + commit_confkey $h, $k, @acc; + $k = $1; + @acc = ($2); + } else { + die "$conf:$n: invalid config line\n"; + } + $line = <$fh>; + } + commit_confkey $h, $k, @acc; + return %c; +} + +sub conf_var ($$;$) { + my ($g, $v, $d) = @_; + ## Return the value for V in config group G, or return D by default. + ## If D is omitted then report an error. + + my $r = $C{$g}{$v}; + $r = $C{""}{$v} unless defined $r || $g eq ""; + $r = $d unless defined $r; + die "missing config variable `$g/$v'" unless defined $r; + return $r; +} + +###-------------------------------------------------------------------------- +### Updating a configuration repository. + +our (%G, %U); + +sub subst_user ($$$) { + my ($g, $u, $s) = @_; + ## Return S, with appropriate substitutions made. + + my %map = ( "G" => $g, + "U" => $u, + "%" => "%" ); + $s =~ s/\%(.)/$map{$1} || "\%$1"/eg; + return $s; +} + +sub check_user_name ($$) { + my ($g, $u) = @_; + ## Complain if U isn't a valid user name for group G. + + my $pat = conf_var "conf:$g", "userpat", "[-_0-9a-z]+"; + die "bad user name `$u'\n" unless $u =~ /^$pat$/; +} + +sub write_conffiles ($$) { + my ($g, $u) = @_; + ## Write the necessary files for a user U in group G. + + my $ff = $C{"files:$g"}; + die "unknown group `$g'\n" unless $ff; + + for my $f (keys %$ff) { + my $fn = subst_user $g, $u, $f; + if ((my $d = $fn) =~ s:/[^/]+$::) { make_path $d; } + open my $fh, ">", "$fn.new"; + print $fh subst_user($g, $u, $ff->{$f}), "\n"; + close $fh; + rename "$fn.new", $fn; + } +} + +sub delete_conffiles ($$) { + my ($g, $u) = @_; + ## Delete configuration files for a user U in group G. + + my $ff = $C{"files:$g"}; + die "unknown group `$g'\n" unless $ff; + + for my $f (keys %$ff) { + my $fn = subst_user $g, $u, $f; + unlink $fn; + } +} + +sub parse_userinfo_word ($@) { + my ($k, @a) = @_; + ## Helper for `read_userinfo_file': return the only word from its argument + ## list. + + die "`$k' wants a single argument\n" unless @a == 1; + return $a[0]; +} + +sub parse_userinfo_list ($@) { + my ($k, @a) = @_; + ## Helper for `read_userinfo_file': return the remaining arguments as an + ## arrayref. + + return \@a; +} + +## Mapping userinfo file tags to helper functions which parse their +## arguments. The helpers take arguments TAG, ARGS ... and are expected to +## return a properly Perlish value to be stored in the userinfo hash. +our %USERINFO = ( user => \&parse_userinfo_word, + group => \&parse_userinfo_word, + path => \&parse_userinfo_list ); + +sub read_userinfo_file ($) { + my ($fn) = @_; + ## Parse a userinfo file, returning the results as a hashref. + + my $fh; + eval { open $fh, "<", "glau.info/$fn"; }; + if (!$@) { } + elsif ($@->isa("autodie::exception") && $@->errno == ENOENT) { + return undef; + } else { + die; + } + + my %i; + while (<$fh>) { + my @w = split; + next unless @w; + my $k = shift @w; + die "INTERNAL: unknown userinfo tag `$k'" unless $USERINFO{$k}; + $i{$k} = &{$USERINFO{$k}}($k, @w); + } + for my $k (keys %USERINFO) { + die "INTERNAL: missing userinfo tag `$k'" unless exists $i{$k}; + } + return \%i; +} + +sub decorated_user_name ($$) { + my ($g, $u) = @_; + ## Take a raw group G and user name U, and return the Gitolite-facing + ## decorated user name. + + die "unknown group `$g'\n" unless $C{"conf:$g"}; + return subst_user $g, $u, conf_var "conf:$g", "decorate", "%U"; +} + +sub read_userinfo ($$) { + my ($g, $u) = @_; + ## Read and return a userinfo hash for the given group/user combination. + + my $fn = decorated_user_name $g, $u; + return read_userinfo_file $fn; +} + +sub check_userinfo_tags ($@) { + my ($i, @must) = @_; + ## Check that the userinfo I has all of the necessary tags, and nothing + ## else. + + @must = keys %USERINFO unless @must; + for my $k (@must) + { die "INTERNAL: missing userinfo tag `$k'" unless exists $i->{$k}; } + for my $k (keys %$i) + { die "INTERNAL: unexpected userinfo tag `$k'" unless $USERINFO{$k}; } +} + +sub write_userinfo (+;$) { + my ($i, $dir) = @_; + ## Create a new userinfo file for the information I, writing it to DIR. + + $dir //= "glau.info"; + check_userinfo_tags $i; + + make_path $dir; + my $fn = "$dir/" . decorated_user_name $i->{group}, $i->{user}; + open my $fh, ">", $fn; + for my $k (keys %$i) { + my $x = $i->{$k}; + my $t = ref $x; + if ($t eq "ARRAY") { printf $fh "%s %s\n", $k, join " ", @$x; } + elsif ($t eq "") { printf $fh "%s %s\n", $k, $x; } + else { die "INTERNAL: unexpected ref type `$t' in user info"; } + } + close $fh; +} + +sub delete_userinfo (+) { + my ($i) = @_; + ## Create a new userinfo file for the information I. + + check_userinfo_tags $i, "user", "group"; + unlink "glau.info/" . decorated_user_name $i->{group}, $i->{user}; +} + +sub map_allusers (&) { + my ($proc) = @_; + ## Call PROC(I) for each userinfo known to the system. + + opendir my $d, "glau.info"; + while (my $f = readdir $d) { + next if $f eq "." || $f eq ".."; + &$proc(read_userinfo_file $f); + } +} + +sub map_userkeys (&$$) { + my ($proc, $g, $u) = @_; + ## Call PROC(KI) for each key known for the user U in group G. + ## + ## The KI argument is a hashref: + ## + ## keyid The keyid, with initial `@'. + ## fn The leaf filename, relative to the current directory. + ## path The full filename, from the top of the admin tree. + + my $fn = decorated_user_name $g, $u; + find sub { + &$proc({ fn => $_, path => File::Find::name, + keyid => $3 }) + if -f $_ && /^(zzz-marked-for-(add|del)-|)\Q$fn\E(\@[^.]+|)\.pub$/; + }, "keydir"; +} + +sub existing_keyids ($$) { + my ($g, $u) = @_; + ## Return the existing keyids for a user U in group G. + + my @k; + map_userkeys { push @k, $_[0]->{keyid} } $g, $u; + return @k; +} + +sub write_userkey ($$$$) { + my ($g, $u, $keyid, $k) = @_; + ## Write the key K for a user U in group G, with a given KEYID. + ## The key should be a literal string, including trailing newline. + + make_path "keydir"; + open my $fh, ">", + sprintf "keydir/%s%s.pub", decorated_user_name($g, $u), $keyid; + print $fh $k; + close $fh; +} + +sub delete_userkeys ($$) { + my ($g, $u) = @_; + ## Delete all of a user's keys. + + map_userkeys { unlink $_[0]->{fn} } $g, $u; +} + +sub refresh_conffiles () { + ## Rewrite all of the configuration files we're responsible for. + + for my $d (split " ", conf_var "", "confdirs") { remove_tree $d; } + make_path "glau.info-new"; + map_allusers { + my ($i) = @_; + my ($g, $u) = @{$i}{"group", "user"}; + write_conffiles $g, $u; + write_userinfo $i, "glau.info-new"; + }; + remove_tree "glau.info"; + rename "glau.info-new", "glau.info"; +} + +###-------------------------------------------------------------------------- +### Git things. + +our $TMPDIR; + +sub create_tmpdir () { + ## Create a temporary directory and set `$TMPDIR'. + + ## Maybe we did this already. + return if defined $TMPDIR; + + ## We use `~/tmp/glau.PID' as our temporary directory. We decree that + ## no other hosts are allowed to use this space at the same time. + make_path "$GL_ADMINDIR/tmp"; + $TMPDIR = "$GL_ADMINDIR/tmp/glau.$$"; + remove_tree $TMPDIR; + mkdir $TMPDIR, 0700; +} + +END { chdir $ENV{HOME}; remove_tree $TMPDIR if defined $TMPDIR; } + +sub setup_admin_dir ($) { + my ($who) = @_; + ## Set up a working tree for the admin repository, on behalf of WHO. + + create_tmpdir; + + chdir $TMPDIR; + system "git", "clone", "-q", "$REPO_BASE/gitolite-admin.git", "admin"; + chdir "admin"; + system "git", "config", "user.name", "$who/gitolite-adduser"; +} + +sub commit_admin_dir ($) { + my ($msg) = @_; + ## Commit changes to the admin repository, using MSG as the commit message. + + system "git", "add", "-A", "."; + ##system "git", "diff", "--cached"; + system "git", "commit", "-aq", "-m$msg"; + system "git", "push", "-q"; +} + +###-------------------------------------------------------------------------- +### Permission checks. + +sub check_adc_access ($$) { + my ($g, $u) = @_; + ## Check that the caller has permission to modify user U in group G. + ## + ## This has two parts. Firstly, the caller must have permission to write + ## to the fake `EXTCMD/adduser' repository's `NAME/G/U' branch. Secondly, + ## we insist that the user isn't already `established'. + + die "GL_USER unset\n" unless exists $ENV{GL_USER}; + + ## Check that we have permission. + my $rc = check_access "EXTCMD/adduser", "NAME/$g/$u", "W", 1; + die "permission $rc\n" if $rc =~ /DENIED/; + + ## Check that the subject user isn't established: i.e., either doesn't + ## exist yet, or still has the key that we set up. This allows us to + ## modify the key until the subject user declares independence. + my $fn = decorated_user_name $g, $u; + my @k = existing_keyids $g, $u; + die "user `$u' in group `$g' already established\n" + if @k && !grep /^\@zzz-glau-\Q$ENV{GL_USER}\E$/, @k; +} + +###-------------------------------------------------------------------------- +### Commands. + +package BaseOperation; +## A base class for operations, implements the minimal protocol. +## +## This consists of three methods. +## +## CLASS->userv(\@ARG) Construct and return an object to perform the +## operation given a Userv command-line argument list. +## +## CLASS->parse(\@ARG) Construct and return an object to perform the +## operation given an SSH (ADC) command-line argument +## list. +## +## OP->run() Perform the actual operation. + +sub userv { die "not available via userv\n"; } +sub parse { die "not available as adc\n"; } + +package SetOperation; +use base qw(BaseOperation); +## Set a user's key. Userv callers can only configure their own `@userv' +## key. ADC callers can set a key for another user, subject to +## `check_adc_access'. Reads the `authorized_keys' line from stdin. + +sub new { + my ($cls, $who, $g, $u, $keyid, $path) = @_; + ## Common constructor. + + return bless { who => $who, + group => $g, + user => $u, + keyid => $keyid, + path => $path }, $cls; +} + +sub userv { + my ($cls, $arg) = @_; + + my $u = $ENV{"USERV_USER"}; + my $g = ::conf_var "", "uservgroup", "local"; + return $cls->new($u, $g, $u, "\@userv", []); +} + +sub parse { + my ($cls, $arg) = @_; + + my $g = ::arg @$arg, "group name"; + my $u = ::arg @$arg, "user name"; + my $who = $ENV{GL_USER}; + my $i = ::read_userinfo_file $who; + die "who are you?\n" unless $i; + ::check_adc_access $g, $u; + return $cls->new($who, $g, $u, "\@zzz-glau-$who", $i->{path}); +} + +sub run { + my ($me) = @_; + + my $k; + ::check_user_name $me->{group}, $me->{user}; + my $n = read STDIN, $k, 4096; + my @f = split " ", $k; + die "malformed public key\n" unless + defined $k && $n && + @f == 3 && $k =~ /^[^\n]*\n\z/ && + $f[0] =~ /^(ssh-|ecdsa-)/; + + my $g = $me->{group}; + my $u = $me->{user}; + + ::write_userinfo { group => $g, + user => $u, + path => [@{$me->{path}}, "$g/$u"] }; + ::write_conffiles $g, $u; + ::write_userkey $g, $u, $me->{keyid}, $k; + ::commit_admin_dir "gitolite-adduser for $me->{who}: set key for $g/$u"; +} + +package DeleteOperation; +use base qw(BaseOperation); +## Only available as an ADC operation: delete an existing unestablished user +## (subject to `check_adc_access'). + +sub parse { + my ($cls, $arg) = @_; + + my $g = ::arg @$arg, "group name"; + my $u = ::arg @$arg, "user name"; + ::check_adc_access $g, $u; + return bless { who => $ENV{GL_USER}, + group => $g, + user => $u }, $cls; +} + +sub run { + my ($me) = @_; + + my $g = $me->{group}; + my $u = $me->{user}; + + ::delete_userinfo { group => $g, user => $u }; + ::delete_conffiles $g, $u; + ::delete_userkeys $g, $u; + ::commit_admin_dir "gitolite-adduser for $me->{who}: delete $g/$u"; +} + +package RewriteOperation; +use base qw(BaseOperation); +## Rewrite all of the configuration files. This is only available via Userv +## (and should be restricted to administrators). + +sub userv { + my ($cls) = @_; + return bless { who => $ENV{USERV_USER} }, $cls; +} + +sub run { + my ($me) = @_; + ::refresh_conffiles; + ::commit_admin_dir "gitolite-adduser for $me->{who}: rewrite"; +} + +package main; + +###-------------------------------------------------------------------------- +### Main dispatch. + +(my $prog = $0) =~ s:^.*/::; + +eval { + our %C = read_config "$GL_ADMINDIR/conf/adduser.conf"; + + our %OPMAP = ( set => 'SetOperation', + del => 'DeleteOperation', + rewrite => 'RewriteOperation' ); + + my @a = @ARGV; + my $op; + + $ENV{GL_BYPASS_UPDATE_HOOK} = "t"; + $ENV{GL_ADMINDIR} = $GL_ADMINDIR; + + if (exists $ENV{USERV_USER}) { + my $opname = $ENV{USERV_SERVICE}; + my $opcls = $OPMAP{$opname} or die "unknown operation `$opname'\n"; + setup_admin_dir $ENV{USERV_USER}; + $op = $opcls->userv(\@a); + } elsif (exists $ENV{GL_USER}) { + my $opname = arg @a, "operation"; + my $opcls = $OPMAP{$opname} or die "unknown operation `$opname'\n"; + setup_admin_dir $ENV{GL_USER}; + $op = $opcls->parse(\@a); + } else { + die "unknown service framework\n"; + } + + die "excess arguments\n" if @a; + + $op->run(); +}; +if ($@) { + print STDERR "$prog: $@"; + exit 1; +} + +###----- That's all, folks -------------------------------------------------- diff --git a/adduser.conf b/adduser.conf new file mode 100644 index 0000000..746d404 --- /dev/null +++ b/adduser.conf @@ -0,0 +1,21 @@ +;;; + +confdirs = conf/group conf/admin + +[conf:local] + +[files:local] +conf/group/%U.conf: + @local = %U + +conf/admin/%U.conf: + @u-%U = u/%U/..* + repo gitolite-admin + RW NAME/conf/u/u-%U = %U + +[conf:ext] +userpat = [-+._0-9a-z]+@[-0-9a-z]+(\.[-0-9a-z]+)+ + +[files:ext] +conf/group/%U.conf: + @ext = %U diff --git a/userv/rewrite b/userv/rewrite new file mode 100644 index 0000000..1c252c9 --- /dev/null +++ b/userv/rewrite @@ -0,0 +1,10 @@ +### -*-conf-*- + +if grep calling-user .userv/admin-users + suppress-args + no-set-environment + execute env \ + GL_BINDIR=/usr/share/gitolite \ + GL_RC=/var/lib/gitolite/.gitolite.rc \ + adc/adduser +fi diff --git a/userv/set b/userv/set new file mode 100644 index 0000000..971304e --- /dev/null +++ b/userv/set @@ -0,0 +1,10 @@ +### -*-conf-*- + +if grep calling-user-shell /etc/shells + suppress-args + no-set-environment + execute env \ + GL_BINDIR=/usr/share/gitolite \ + GL_RC=/var/lib/gitolite/.gitolite.rc \ + adc/adduser +fi -- 2.11.0