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