Girocco/User.pm

   1 package Girocco::User;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Digest::MD5 qw(md5);
   7
   8 use Girocco::Config;
   9 use Girocco::CGI;
  10 use Girocco::Util;
  11 use Girocco::SSHUtil;
  12
  13 BEGIN {
  14         eval {
  15                 require Digest::SHA;
  16                 Digest::SHA->import(
  17                         qw(sha1_hex)
  18         );1} ||
  19         eval {
  20                 require Digest::SHA1;
  21                 Digest::SHA1->import(
  22                         qw(sha1_hex)
  23         );1} ||
  24         eval {
  25                 require Digest::SHA::PurePerl;
  26                 Digest::SHA::PurePerl->import(
  27                         qw(sha1_hex)
  28         );1} ||
  29         die "One of Digest::SHA or Digest::SHA1 or Digest::SHA::PurePerl "
  30         . "must be available\n";
  31 }
  32
  33 sub _gen_uuid {
  34         my $self = shift;
  35
  36         $self->{uuid} = '' unless $self->{uuid};
  37         my @md5 = unpack('C*', md5(time . $$ . rand() . join(':',%$self)));
  38         $md5[6] = 0x40 | ($md5[6] & 0x0F); # Version 4 -- random
  39         $md5[8] = 0x80 | ($md5[8] & 0x3F); # RFC 4122 specification
  40         return sprintf(
  41                 '%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x',
  42                 @md5);
  43 }
  44
  45 sub _remove_ssh_leftovers {
  46         my $self = shift;
  47         system "rm -f '$Girocco::Config::chroot/etc/sshkeys/$self->{name}'";
  48         system "rm -f '$Girocco::Config::chroot/etc/sshcerts/${Girocco::Config::nickname}_$self->{name}'_user_*.pem";
  49 }
  50
  51 sub _passwd_add {
  52         my $self = shift;
  53         my (undef, undef, $gid) = getgrnam($Girocco::Config::owning_group||'');
  54         my $owngroupid = $gid ? $gid : 65534;
  55         Girocco::User->load($self->{name}) and die "User $self->{name} already exists";
  56         $self->{uuid} = $self->_gen_uuid;
  57         my $email_uuid = join ',', $self->{email}, $self->{uuid};
  58         filedb_atomic_append(jailed_file('/etc/passwd'),
  59                 join(':', $self->{name}, 'x', '\i', $owngroupid, $email_uuid, '/', '/bin/git-shell-verify'));
  60         $self->_remove_ssh_leftovers;
  61 }
  62
  63 sub _passwd_update {
  64         my $self = shift;
  65         filedb_atomic_edit(jailed_file('/etc/passwd'),
  66                 sub {
  67                         $_ = $_[0];
  68                         chomp;
  69                         if ($self->{name} eq (split /:/)[0]) {
  70                                 # preserve all but login name and comment field
  71                                 my @fields=split(/:/, $_, -1);
  72                                 $fields[0] = $self->{name};
  73                                 $self->{uuid} = (split(',', $fields[4]))[1] || '';
  74                                 $self->{uuid} or $self->{uuid} = $self->_gen_uuid;
  75                                 $fields[4] = join(',', $self->{email}, $self->{uuid});
  76                                 return join(':', @fields)."\n";
  77                         } else {
  78                                 return "$_\n";
  79                         }
  80                 }
  81         );
  82 }
  83
  84 sub _passwd_remove {
  85         my $self = shift;
  86         $self->_remove_ssh_leftovers;
  87         filedb_atomic_edit(jailed_file('/etc/passwd'),
  88                 sub {
  89                         $self->{name} ne (split /:/)[0] and return $_;
  90                 }
  91         );
  92 }
  93
  94 sub _sshkey_path {
  95         my $self = shift;
  96         '/etc/sshkeys/'.$self->{name};
  97 }
  98
  99 sub _sshkey_load {
 100         my $self = shift;
 101         open F, '<', jailed_file($self->_sshkey_path) or die "sshkey load failed: $!";
 102         my @keys = ();
 103         my $auth = '';
 104         my $authtype = '';
 105         while (<F>) {
 106                 chomp;
 107                 if (/^ssh-(?:dss|rsa) /) {
 108                         push @keys, $_;
 109                 } elsif (/^# ([A-Z]+)AUTH ([0-9a-f]+) (\d+)/) {
 110                         my $expire = $3;
 111                         $auth = $2 unless (time >= $expire);
 112                         $authtype = $1 if $auth;
 113                 }
 114         }
 115         close F;
 116         my $keys = join("\n", @keys); chomp $keys;
 117         ($keys, $auth, $authtype);
 118 }
 119
 120 sub _trimkeys {
 121         my $keys = shift;
 122         my @lines = ();
 123         foreach (split /\r\n|\r|\n/, $keys) {
 124                 next if /^[ \t]*$/ || /^[ \t]*#/;
 125                 push(@lines, $_);
 126         }
 127         return join("\n", @lines);
 128 }
 129
 130 sub _sshkey_save {
 131         my $self = shift;
 132         $self->{keys} = _trimkeys($self->{keys} || '');
 133         open F, '>', jailed_file($self->_sshkey_path) or die "sshkey save failed: $!";
 134         if (defined($self->{auth}) && $self->{auth}) {
 135                 my $expire = time + 24 * 3600;
 136                 my $typestr = $self->{authtype} ? uc($self->{authtype}) : 'REPO';
 137                 print F "# ${typestr}AUTH $self->{auth} $expire\n";
 138         }
 139         print F $self->{keys};
 140         print F "\n" if $self->{keys};
 141         close F;
 142         chmod 0664, jailed_file($self->_sshkey_path);
 143 }
 144
 145 # private constructor, do not use
 146 sub _new {
 147         my $class = shift;
 148         my ($name) = @_;
 149         Girocco::User::valid_name($name) or die "refusing to create user with invalid name ($name)!";
 150         my $proj = { name => $name };
 151
 152         bless $proj, $class;
 153 }
 154
 155 # public constructor #0
 156 # creates a virtual user not connected to disk record
 157 # you can conjure() it later to disk
 158 sub ghost {
 159         my $class = shift;
 160         my ($name) = @_;
 161         my $self = $class->_new($name);
 162         $self;
 163 }
 164
 165 # public constructor #1
 166 sub load {
 167         my $class = shift;
 168         my ($name) = @_;
 169
 170         open F, '<', jailed_file("/etc/passwd") or die "user load failed: $!";
 171         while (<F>) {
 172                 chomp;
 173                 @_ = split /:/;
 174                 next unless (shift eq $name);
 175
 176                 my $self = $class->_new($name);
 177
 178                 my $email_uuid;
 179                 (undef, $self->{uid}, undef, $email_uuid) = @_;
 180                 ($self->{keys}, $self->{auth}, $self->{authtype}) = $self->_sshkey_load;
 181                 ($self->{email}, $self->{uuid}) = split ',', $email_uuid;
 182
 183                 close F;
 184                 $self->{uuid} or $self->_passwd_update;
 185                 return $self;
 186         }
 187         close F;
 188         undef;
 189 }
 190
 191 # public constructor #2
 192 sub load_by_uid {
 193         my $class = shift;
 194         my ($uid) = @_;
 195
 196         open F, '<', jailed_file("/etc/passwd") or die "user load failed: $!";
 197         while (<F>) {
 198                 chomp;
 199                 @_ = split /:/;
 200                 next unless ($_[2] eq $uid);
 201
 202                 my $self = $class->_new($_[0]);
 203
 204                 my $email_uuid;
 205                 (undef, undef, $self->{uid}, undef, $email_uuid) = @_;
 206                 ($self->{keys}, $self->{auth}, $self->{authtype}) = $self->_sshkey_load;
 207                 ($self->{email}, $self->{uuid}) = split ',', $email_uuid;
 208
 209                 close F;
 210                 $self->{uuid} or $self->_passwd_update;
 211                 return $self;
 212         }
 213         close F;
 214         undef;
 215 }
 216
 217 # $user may not be in sane state if this returns false!
 218 sub cgi_fill {
 219         my $self = shift;
 220         my ($gcgi) = @_;
 221         my $cgi = $gcgi->cgi;
 222
 223         $self->{name} = $gcgi->wparam('name');
 224         Girocco::User::valid_name($self->{name})
 225                 or $gcgi->err("Name contains invalid characters.");
 226
 227         $self->{email} = $gcgi->wparam('email');
 228         valid_email($self->{email})
 229                 or $gcgi->err("Your email sure looks weird...?");
 230
 231         $self->keys_fill($gcgi);
 232 }
 233
 234 sub update_email {
 235         my $self = shift;
 236         my $gcgi = shift;
 237         my $email = shift || '';
 238
 239         if (valid_email($email)) {
 240                 $self->{email} = $email;
 241                 $self->_passwd_update;
 242         } else {
 243                 $gcgi->err("Your email sure looks weird...?");
 244         }
 245
 246         not $gcgi->err_check;
 247 }
 248
 249 sub _checkkey {
 250         my $key = shift;
 251         my ($type, $bits, $fingerprint, $comment) = sshpub_validate($key);
 252         return $type ? 1 : 0;
 253 }
 254
 255 sub keys_fill {
 256         my $self = shift;
 257         my ($gcgi) = @_;
 258         my $cgi = $gcgi->cgi;
 259
 260         $self->{keys} = _trimkeys($cgi->param('keys'));
 261         length($self->{keys}) <= 4096
 262                 or $gcgi->err("The list of keys is more than 4kb. Do you really need that much?");
 263         foreach (split /\r?\n/, $self->{keys}) {
 264                 my $keyval;
 265                 /^ssh-(?:dss|rsa) [0-9A-Za-z+\/=]+ \S+@\S+$/ && _checkkey($_)
 266                         or $keyval=CGI::escapeHTML($_),$gcgi->err(<<EOT);
 267 Your ssh key ("$keyval") appears to have an invalid format
 268 (does not start with ssh-dss or ssh-rsa or does not end with <tt>\@</tt>-identifier) -
 269 maybe your browser has split a single key onto multiple lines?
 270 EOT
 271         }
 272
 273         not $gcgi->err_check;
 274 }
 275
 276 sub keys_save {
 277         my $self = shift;
 278
 279         $self->_sshkey_save;
 280 }
 281
 282 sub keys_html_list {
 283         my $self = shift;
 284         my @keys = split(/\r?\n/, $self->{keys});
 285         return '' if !@keys;
 286         my $html = "<ol>\n";
 287         my %types = ('ssh-dss' => 'DSA', 'ssh-rsa' => 'RSA');
 288         my $line = 0;
 289         foreach (@keys) {
 290                 ++$line;
 291                 my ($type, $bits, $fingerprint, $comment) = sshpub_validate($_);
 292                 next unless $type && $types{$type};
 293                 my $euser = CGI::escapeHTML(CGI::Util::escape($self->{name}));
 294                 $html .= "<li>$bits <tt>$fingerprint</tt> ($types{$type}) $comment";
 295                 $html .= "<br /><a target=\"_blank\" ".
 296                         "href=\"@{[url_path($Girocco::Config::webadmurl)]}/usercert.cgi/$euser/$line/".
 297                         $Girocco::Config::nickname."_${euser}_user_$line.pem\">".
 298                         "download https push user authentication certificate</a> <sup>".
 299                         "<a target=\"_blank\" href=\"@{[url_path($Girocco::Config::htmlurl)]}/httpspush.html\">".
 300                         "(learn more)</a></sup>"
 301                         if $type eq 'ssh-rsa' && $Girocco::Config::httpspushurl &&
 302                                 $Girocco::Config::clientcert &&
 303                                 $Girocco::Config::clientkey;
 304                 $html .= "</li>\n";
 305         }
 306         $html .= "</ol>\n";
 307         return $html;
 308 }
 309
 310 sub gen_auth {
 311         my $self = shift;
 312         my ($type) = @_;
 313         $type = 'REPO' unless $type =~ /^[A-Z]+$/;
 314
 315         $self->{authtype} = $type;
 316         $self->{auth} = sha1_hex(time . $$ . rand() . $self->{keys});
 317         $self->_sshkey_save;
 318         $self->{auth};
 319 }
 320
 321 sub del_auth {
 322         my $self = shift;
 323
 324         delete $self->{auth};
 325         delete $self->{authtype};
 326 }
 327
 328 sub get_projects {
 329         my $self = shift;
 330
 331         return @{$self->{projects}} if defined($self->{projects});
 332         my @projects = filedb_atomic_grep(jailed_file('/etc/group'),
 333                 sub {
 334                         $_ = $_[0];
 335                         chomp;
 336                         my ($group, $users) = (split /:/)[0,3];
 337                         $group if $users && $users =~ /(^|,)\Q$self->{name}\E(,|$)/;
 338                 }
 339         );
 340         $self->{projects} = \@projects;
 341         @{$self->{projects}};
 342 }
 343
 344 sub conjure {
 345         my $self = shift;
 346
 347         $self->_passwd_add;
 348         $self->_sshkey_save;
 349 }
 350
 351 sub remove {
 352         my $self = shift;
 353
 354         require Girocco::Project;
 355         foreach ($self->get_projects) {
 356                 if (Girocco::Project::does_exist($_)) {
 357                         my $project = Girocco::Project->load($_);
 358                         $project->update if $project->remove_user($self->{name});
 359                 }
 360         }
 361
 362         $self->_passwd_remove;
 363 }
 364
 365 ### static methods
 366
 367 sub valid_name {
 368         $_ = $_[0];
 369         /^[a-zA-Z0-9+._-]+$/;
 370 }
 371
 372 sub does_exist {
 373         my ($name) = @_;
 374         Girocco::User::valid_name($name) or die "tried to query for user with invalid name $name!";
 375         (-e jailed_file("/etc/sshkeys/$name"));
 376 }
 377
 378 sub resolve_uid {
 379         my ($name) = @_;
 380         $Girocco::Config::chrooted and undef; # TODO for ACLs within chroot
 381         scalar(getpwnam($name));
 382 }
 383
 384
 385 1;