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