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