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         my @files;
  52         system('rm', '-f', "$Girocco::Config::chroot/etc/sshkeys/$self->{name}");
  53         @files = glob("'$Girocco::Config::chroot/etc/sshcerts/${Girocco::Config::nickname}_$self->{name}'_user_*.pem");
  54         system('rm', '-f', @files) if @files;
  55         system('rm', '-f', "$Girocco::Config::chroot/etc/sshactive/$self->{name}");
  56         @files = glob("'$Girocco::Config::chroot/etc/sshactive/$self->{name}',*");
  57         system('rm', '-f', @files) if @files;
  58 }
  59
  60 sub _passwd_add {
  61         use POSIX qw(strftime);
  62         my $self = shift;
  63         my (undef, undef, $gid) = getgrnam($Girocco::Config::owning_group||'');
  64         my $owngroupid = $gid ? $gid : 65534;
  65         Girocco::User->load($self->{name}) and die "User $self->{name} already exists";
  66         $self->{uuid} = $self->_gen_uuid;
  67         my ($S,$M,$H,$d,$m,$y) = gmtime(time());
  68         $self->{creationtime} = strftime("%Y%m%d_%H%M%S", $S, $M, $H, $d, $m, $y, -1, -1, -1);
  69         my $email_uuid_etc = join ',', $self->{email}, $self->{uuid}, $self->{creationtime};
  70         filedb_atomic_append(jailed_file('/etc/passwd'),
  71                 join(':', $self->{name}, 'x', '\i', $owngroupid, $email_uuid_etc, '/', '/bin/git-shell-verify'),
  72                 $self->{name});
  73         $self->_remove_ssh_leftovers;
  74 }
  75
  76 sub _passwd_update {
  77         my $self = shift;
  78         filedb_atomic_edit(jailed_file('/etc/passwd'),
  79                 sub {
  80                         $_ = $_[0];
  81                         chomp;
  82                         if ($self->{name} eq (split /:/)[0]) {
  83                                 # preserve all but login name and first 2 fields of comment field
  84                                 # creating a uuid (field 2 of comment field) if one is not already present
  85                                 my @fields=split(/:/, $_, -1);
  86                                 $fields[0] = $self->{name};
  87                                 my @subfields = split(',', $fields[4]||'', -1);
  88                                 $self->{uuid} = $subfields[1] || '';
  89                                 $self->{uuid} or $self->{uuid} = $self->_gen_uuid;
  90                                 $subfields[0] = $self->{email};
  91                                 $subfields[1] = $self->{uuid};
  92                                 $fields[4] = join(',', @subfields);
  93                                 return join(':', @fields)."\n";
  94                         } else {
  95                                 return "$_\n";
  96                         }
  97                 },
  98                 $self->{name}
  99         );
 100 }
 101
 102 sub _passwd_remove {
 103         my $self = shift;
 104         $self->_remove_ssh_leftovers;
 105         filedb_atomic_edit(jailed_file('/etc/passwd'),
 106                 sub {
 107                         $self->{name} ne (split /:/)[0] and return $_;
 108                 },
 109                 $self->{name}
 110         );
 111 }
 112
 113 sub _sshkey_path {
 114         my $self = shift;
 115         '/etc/sshkeys/'.$self->{name};
 116 }
 117
 118 sub _sshkey_load {
 119         my $self = shift;
 120         open my $fd, '<', jailed_file($self->_sshkey_path) or die "sshkey load failed: $!";
 121         my @keys = ();
 122         my $auth = '';
 123         my $authtype = '';
 124         while (<$fd>) {
 125                 chomp;
 126                 if (/^(?:no-pty )?(ssh-(?:dss|rsa) .*)$/) {
 127                         push @keys, $1;
 128                 } elsif (/^# ([A-Z]+)AUTH ([0-9a-f]+) (\d+)/) {
 129                         my $expire = $3;
 130                         $auth = $2 unless (time >= $expire);
 131                         $authtype = $1 if $auth;
 132                 }
 133         }
 134         close $fd;
 135         my $keys = join("\n", @keys); chomp $keys;
 136         ($keys, $auth, $authtype);
 137 }
 138
 139 sub _trimkeys($) {
 140         my $keys = shift;
 141         my @lines = ();
 142         foreach (split /\r\n|\r|\n/, $keys) {
 143                 next if /^[ \t]*$/ || /^[ \t]*#/;
 144                 push(@lines, $_);
 145         }
 146         return join("\n", @lines);
 147 }
 148
 149 sub _sshkey_save {
 150         my $self = shift;
 151         $self->{keys} = _trimkeys($self->{keys} || '');
 152         open my $fd, '>', jailed_file($self->_sshkey_path) or die "sshkey save failed: $!";
 153         if (defined($self->{auth}) && $self->{auth}) {
 154                 my $expire = time + 24 * 3600;
 155                 my $typestr = $self->{authtype} ? uc($self->{authtype}) : 'REPO';
 156                 print $fd "# ${typestr}AUTH $self->{auth} $expire\n";
 157         }
 158         print $fd map("no-pty $_\n", split(/\n/, $self->{keys}));
 159         close $fd;
 160         chmod 0664, jailed_file($self->_sshkey_path);
 161 }
 162
 163 # private constructor, do not use
 164 sub _new {
 165         my $class = shift;
 166         my ($name, $rsrv_sfx_ok) = @_;
 167         Girocco::User::valid_name(\$name, $rsrv_sfx_ok ? $Girocco::Config::chroot."/etc/sshkeys" : undef)
 168                 or die "refusing to create user with invalid name ($name)!";
 169         my $user = { name => $name };
 170
 171         bless $user, $class;
 172 }
 173
 174 # public constructor #0
 175 # creates a virtual user not connected to disk record
 176 # you can conjure() it later to disk
 177 sub ghost {
 178         my $class = shift;
 179         my ($name) = @_;
 180         my $self = $class->_new($name);
 181         $self;
 182 }
 183
 184 # public constructor #1
 185 sub load {
 186         my $class = shift;
 187         my ($name) = @_;
 188
 189         open my $fd, '<', jailed_file("/etc/passwd") or die "user load failed: $!";
 190         my $r = qr/^\Q$name\E:/;
 191         foreach (grep /$r/, <$fd>) {
 192                 chomp;
 193
 194                 my (undef, undef, $uid, undef, $email_uuid_etc) = split /:/;
 195                 my $self = $class->_new($name, 1);
 196                 $uid =~ /^(\d+)$/ or next; $self->{uid} = $1;
 197                 defined($email_uuid_etc) or $email_uuid_etc = '';
 198                 my ($email, $uuid, $ct) = split ',', $email_uuid_etc;
 199                 defined($email) or $email = '';
 200                 {use bytes; $email =~ /^([^\x00-\x1F\x7F]*)$/ or next; $self->{email} = $1;}
 201                 defined($uuid) && $uuid ne '' or $uuid = '';
 202                 if ($uuid ne '') {
 203                         $uuid =~ /^([0-9a-fA-F]{8}-(?:[0-9a-fA-F]{4}-){3}[0-9a-fA-F]{12})$/ or
 204                                 next;
 205                         $uuid = lc($1);
 206                 }
 207                 $self->{uuid} = $uuid;
 208                 defined($ct) && $ct ne '' or $ct = '';
 209                 if ($ct ne '') {
 210                         $ct =~ /^(\d{8}_\d{6})$/ or next;
 211                         $ct = $1;
 212                 }
 213                 $self->{creationtime} = $ct;
 214                 ($self->{keys}, $self->{auth}, $self->{authtype}) = $self->_sshkey_load;
 215
 216                 close $fd;
 217                 $self->{uuid} or !valid_email($self->{email}) or $self->_passwd_update;
 218                 return $self;
 219         }
 220         close $fd;
 221         undef;
 222 }
 223
 224 # public constructor #2
 225 sub load_by_uid {
 226         my $class = shift;
 227         my ($uid) = @_;
 228
 229         open my $fd, '<', jailed_file("/etc/passwd") or die "user load failed: $!";
 230         my $r = qr/^[^:]+:[^:]*:\Q$uid\E:/;
 231         foreach (grep /$r/, <$fd>) {
 232                 chomp;
 233
 234                 my ($name, undef, undef, undef, $email_uuid_etc) = split /:/;
 235                 my $self = $class->_new($name, 1);
 236                 $self->{uid} = $uid;
 237                 ($self->{keys}, $self->{auth}, $self->{authtype}) = $self->_sshkey_load;
 238                 ($self->{email}, $self->{uuid}, $self->{creationtime}) = split ',', $email_uuid_etc;
 239
 240                 close $fd;
 241                 $self->{uuid} or $self->_passwd_update;
 242                 return $self;
 243         }
 244         close $fd;
 245         undef;
 246 }
 247
 248 # $user may not be in sane state if this returns false!
 249 sub cgi_fill {
 250         my $self = shift;
 251         my ($gcgi) = @_;
 252         my $cgi = $gcgi->cgi;
 253
 254         $self->{name} = $gcgi->wparam('name');
 255         Girocco::User::valid_name($self->{name})
 256                 or $gcgi->err("Name contains invalid characters.");
 257
 258         length($self->{name}) <= 64
 259                 or $gcgi->err("Your user name is longer than 64 characters. Do you really need that much?");
 260
 261         $self->{email} = $gcgi->wparam('email');
 262         valid_email($self->{email})
 263                 or $gcgi->err("Your email sure looks weird...?");
 264         length($self->{email}) <= 96
 265                 or $gcgi->err("Your email is longer than 96 characters. Do you really need that much?");
 266
 267         $self->keys_fill($gcgi);
 268 }
 269
 270 sub update_email {
 271         my $self = shift;
 272         my $gcgi = shift;
 273         my $email = shift || '';
 274
 275         if (valid_email($email)) {
 276                 $self->{email} = $email;
 277                 $self->_passwd_update;
 278         } else {
 279                 $gcgi->err("Your email sure looks weird...?");
 280         }
 281
 282         not $gcgi->err_check;
 283 }
 284
 285 sub keys_fill {
 286         my $self = shift;
 287         my ($gcgi) = @_;
 288         my $cgi = $gcgi->cgi;
 289
 290         $self->{keys} = _trimkeys($cgi->param('keys'));
 291         length($self->{keys}) <= 9216
 292                 or $gcgi->err("The list of keys is more than 9kb. Do you really need that much?");
 293         foreach my $key (split /\r?\n/, $self->{keys}) {
 294                 my ($type, $bits, $fingerprint, $comment);
 295                 ($type, $bits, $fingerprint, $comment) = sshpub_validate($key)
 296                         if $key =~ /^ssh-(?:dss|rsa) [0-9A-Za-z+\/=]+ \S+$/;
 297                 if (!$type) {
 298                         my $keyval = CGI::escapeHTML($key);
 299                         my $dsablurb = '';
 300                         $dsablurb = ' or ssh-dss' unless $Girocco::Config::disable_dsa;
 301                         $gcgi->err(<<EOT);
 302 Your ssh key ("$keyval") appears to have an invalid format
 303 (does not start with ssh-rsa$dsablurb or does not end with a whitespace-free comment) -
 304 maybe your browser has split a single key onto multiple lines?
 305 EOT
 306                 } elsif ($Girocco::Config::disable_dsa && $type eq 'ssh-dss') {
 307                         my $keyval = CGI::escapeHTML($key);
 308                         $gcgi->err(<<EOT);
 309 Your ssh key ("$keyval") appears to be of type dsa but only rsa keys are
 310 supported - please generate an rsa key (starts with ssh-rsa) and try again
 311 EOT
 312                 } elsif ($bits > 16384) {
 313                         my $keyval = CGI::escapeHTML($key);
 314                         $gcgi->err(<<EOT);
 315 Your ssh key ("$keyval") appears to have more than 16384 bits, please don't
 316 unnecessarily overburden our processors - please limit yourself to keys of
 317 16384 bits or less.
 318 EOT
 319                 } elsif ($Girocco::Config::min_key_length && $bits < $Girocco::Config::min_key_length) {
 320                         my $keyval = CGI::escapeHTML($key);
 321                         $gcgi->err(<<EOT);
 322 Your ssh key ("$keyval") appears to have only $bits bit(s) but at least
 323 $Girocco::Config::min_key_length are required - please generate a longer key
 324 EOT
 325                 }
 326         }
 327
 328         not $gcgi->err_check;
 329 }
 330
 331 sub keys_save {
 332         my $self = shift;
 333
 334         $self->_sshkey_save;
 335 }
 336
 337 sub keys_html_list {
 338         my $self = shift;
 339         my @keys = split(/\r?\n/, $self->{keys});
 340         return '' if !@keys;
 341         my $html = "<ol>\n";
 342         my %types = ('ssh-dss' => 'DSA', 'ssh-rsa' => 'RSA');
 343         my $line = 0;
 344         foreach (@keys) {
 345                 ++$line;
 346                 my ($type, $bits, $fingerprint, $comment) = sshpub_validate($_);
 347                 next unless $type && $types{$type};
 348                 my $euser = CGI::escapeHTML(CGI::Util::escape($self->{name}));
 349                 $html .= "<li>$bits <tt>$fingerprint</tt> ($types{$type}) $comment";
 350                 $html .= "<br /><a target=\"_blank\" ".
 351                         "href=\"@{[url_path($Girocco::Config::webadmurl)]}/usercert.cgi/$euser/$line/".
 352                         $Girocco::Config::nickname."_${euser}_user_$line.pem\">".
 353                         "download https push user authentication certificate</a> <sup class=\"sup\"><span>".
 354                         "<a target=\"_blank\" href=\"@{[url_path($Girocco::Config::htmlurl)]}/httpspush.html\">".
 355                         "(learn more)</a></span></sup>"
 356                         if $type eq 'ssh-rsa' && $Girocco::Config::httpspushurl &&
 357                                 $Girocco::Config::clientcert &&
 358                                 $Girocco::Config::clientkey;
 359                 $html .= "</li>\n";
 360         }
 361         $html .= "</ol>\n";
 362         return $html;
 363 }
 364
 365 sub gen_auth {
 366         my $self = shift;
 367         my ($type) = @_;
 368         $type = 'REPO' unless $type && $type =~ /^[A-Z]+$/;
 369
 370         $self->{authtype} = $type;
 371         $self->{auth} = sha1_hex(time . $$ . rand() . $self->{keys});
 372         $self->_sshkey_save;
 373         $self->{auth};
 374 }
 375
 376 sub del_auth {
 377         my $self = shift;
 378
 379         delete $self->{auth};
 380         delete $self->{authtype};
 381 }
 382
 383 sub get_projects {
 384         my $self = shift;
 385
 386         return @{$self->{projects}} if defined($self->{projects});
 387         my @projects = filedb_atomic_grep(jailed_file('/etc/group'),
 388                 sub {
 389                         $_ = $_[0];
 390                         chomp;
 391                         my ($group, $users) = (split /:/)[0,3];
 392                         $group if $users && $users =~ /(^|,)\Q$self->{name}\E(,|$)/;
 393                 }
 394         );
 395         $self->{projects} = \@projects;
 396         @{$self->{projects}};
 397 }
 398
 399 sub conjure {
 400         my $self = shift;
 401
 402         $self->_passwd_add;
 403         $self->_sshkey_save;
 404 }
 405
 406 sub remove {
 407         my $self = shift;
 408
 409         require Girocco::Project;
 410         foreach ($self->get_projects) {
 411                 if (Girocco::Project::does_exist($_, 1)) {
 412                         my $project = Girocco::Project->load($_);
 413                         $project->update if $project->remove_user($self->{name});
 414                 }
 415         }
 416
 417         $self->_passwd_remove;
 418 }
 419
 420 ### static methods
 421
 422 # Note that 'mob' and 'everyone' are NOT reserved names per se, but they are
 423 # names with special semantics and they should be allowed in project membership
 424 # lists so they are therefore NOT included in the reservedusernames list.
 425 # 'git', 'lock' and 'bundle'  are reserved so that the personal mob names 'mob.git',
 426 # 'mob.lock' or 'mob.bundle' are not needed as they would be invalid.
 427 our %reservedusernames = (
 428         root => 1,
 429         sshd => 1,
 430         _sshd => 1,
 431         nobody => 1,
 432         lc($Girocco::Config::cgi_user) => 1,
 433         lc($Girocco::Config::mirror_user) => 1,
 434         git => 1,
 435         lock => 1,
 436         bundle => 1,
 437 );
 438
 439 # If $_[0] is a SCALAR ref, ${$_[0]} contains the name and will be untainted on success.
 440 sub valid_name {
 441         local $_ = $_[0];
 442         my $mayberef_name = $_;
 443         ref($_) eq 'SCALAR' and $_ = $$_;
 444         my $rv = (
 445                 /^[a-zA-Z0-9][a-zA-Z0-9+._-]*$/
 446                 and (not m#\.\.#)
 447                 and (not m#\.$#)
 448                 and (not m#\.git$#i)
 449                 and (not m#\.lock$#i)
 450                 and (not m#\.bundle$#i)
 451                 and (not m#^mob[._]#i)
 452                 and !exists($reservedusernames{lc($_)})
 453                 and !has_reserved_suffix($_, $_[1])
 454         );
 455         $rv && ref($mayberef_name) eq 'SCALAR' && m|^(.+)$| and $$mayberef_name = $1;
 456         return $rv;
 457 }
 458
 459 # If $_[0] is a SCALAR ref, ${$_[0]} contains the name and will be untainted on success.
 460 sub does_exist {
 461         my ($mayberef_name, $nodie) = @_;
 462         my $name = $mayberef_name;
 463         ref($mayberef_name) eq 'SCALAR' and $name = $$mayberef_name;
 464         if (!Girocco::User::valid_name($mayberef_name, $Girocco::Config::chroot."/etc/sshkeys")) {
 465                 die "tried to query for user with invalid name $name!" unless $nodie;
 466                 return 0;
 467         }
 468         ref($mayberef_name) eq 'SCALAR' and $name = $$mayberef_name;
 469         (-e jailed_file("/etc/sshkeys/$name"));
 470 }
 471
 472 sub resolve_uid {
 473         my ($name) = @_;
 474         $Girocco::Config::chrooted and undef; # TODO for ACLs within chroot
 475         scalar(getpwnam($name));
 476 }
 477
 478 # returns array of names only taken strictly from the passwd file
 479 # only entries with non-invalid names and uid >= 10000 are returned
 480 # a "non-invalid" name is 1 or more non-whitespace or '#' chars, NOT starting with '_'
 481 sub get_full_list {
 482         open my $fd, '<', jailed_file("/etc/passwd") or die "getting user list failed: $!";
 483         my @users = map {/^([^:_\s#][^:\s#]*):[^:]*:[1-9]\d{4,}:/ ? $1 : ()} <$fd>;
 484         close $fd;
 485         @users;
 486 }
 487
 488 # returns array of array refs containing all fields (at least 3) of each entry from passwd file
 489 # only entries with non-invalid names and uid >= 10000 are returned
 490 # a "non-invalid" name is 1 or more non-whitespace or '#' chars, NOT starting with '_'
 491 # using
 492 #   join(':',@{<array_ref>})
 493 # will recover the _exact_ original line from the passwd file for that entry
 494 sub get_full_list_extended {
 495         open my $fd, '<', jailed_file("/etc/passwd") or die "getting user list failed: $!";
 496         my @users = map {chomp; /^([^:_\s#][^:\s#]*:[^:]*:[1-9]\d{4,}:.*)$/ ? [split(/:/,$1,-1)] : ()} <$fd>;
 497         close $fd;
 498         @users;
 499 }
 500
 501 1;