Merge branch 'master' into rorcz
[girocco.git] / Girocco / User.pm
blob064f6a2740b7a4dd0d622c892c438edae1508ed6
1 package Girocco::User;
3 use strict;
4 use warnings;
6 use Digest::MD5 qw(md5);
8 use Girocco::Config;
9 use Girocco::CGI;
10 use Girocco::Util;
11 use Girocco::SSHUtil;
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";
33 sub _gen_uuid {
34 my $self = shift;
36 $self->{uuid} = '' unless $self->{uuid};
37 my @md5;
39 no warnings;
40 @md5 = unpack('C*', md5(time . $$ . rand() . join(':',%$self)));
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);
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;
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;
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";
98 $self->{name}
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 $_;
109 $self->{name}
113 sub _sshkey_path {
114 my $self = shift;
115 '/etc/sshkeys/'.$self->{name};
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;
134 close $fd;
135 my $keys = join("\n", @keys); chomp $keys;
136 ($keys, $auth, $authtype);
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, $_);
146 return join("\n", @lines);
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";
158 print $fd map("no-pty $_\n", split(/\n/, $self->{keys}));
159 close $fd;
160 chmod 0664, jailed_file($self->_sshkey_path);
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 $proj = { name => $name };
171 bless $proj, $class;
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;
184 # public constructor #1
185 sub load {
186 my $class = shift;
187 my ($name) = @_;
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;
194 my (undef, undef, $uid, undef, $email_uuid_etc) = split /:/;
195 my $self = $class->_new($name, 1);
196 $self->{uid} = $uid;
197 ($self->{keys}, $self->{auth}, $self->{authtype}) = $self->_sshkey_load;
198 ($self->{email}, $self->{uuid}, $self->{creationtime}) = split ',', $email_uuid_etc;
200 close $fd;
201 $self->{uuid} or !valid_email($self->{email}) or $self->_passwd_update;
202 return $self;
204 close $fd;
205 undef;
208 # public constructor #2
209 sub load_by_uid {
210 my $class = shift;
211 my ($uid) = @_;
213 open my $fd, '<', jailed_file("/etc/passwd") or die "user load failed: $!";
214 my $r = qr/^[^:]+:[^:]*:\Q$uid\E:/;
215 foreach (grep /$r/, <$fd>) {
216 chomp;
218 my ($name, undef, undef, undef, $email_uuid_etc) = split /:/;
219 my $self = $class->_new($name, 1);
220 $self->{uid} = $uid;
221 ($self->{keys}, $self->{auth}, $self->{authtype}) = $self->_sshkey_load;
222 ($self->{email}, $self->{uuid}, $self->{creationtime}) = split ',', $email_uuid_etc;
224 close $fd;
225 $self->{uuid} or $self->_passwd_update;
226 return $self;
228 close $fd;
229 undef;
232 # $user may not be in sane state if this returns false!
233 sub cgi_fill {
234 my $self = shift;
235 my ($gcgi) = @_;
236 my $cgi = $gcgi->cgi;
238 $self->{name} = $gcgi->wparam('name');
239 Girocco::User::valid_name($self->{name})
240 or $gcgi->err("Name contains invalid characters.");
242 length($self->{name}) <= 64
243 or $gcgi->err("Your user name is longer than 64 characters. Do you really need that much?");
245 $self->{email} = $gcgi->wparam('email');
246 valid_email($self->{email})
247 or $gcgi->err("Your email sure looks weird...?");
248 length($self->{email}) <= 96
249 or $gcgi->err("Your email is longer than 96 characters. Do you really need that much?");
251 $self->keys_fill($gcgi);
254 sub update_email {
255 my $self = shift;
256 my $gcgi = shift;
257 my $email = shift || '';
259 if (valid_email($email)) {
260 $self->{email} = $email;
261 $self->_passwd_update;
262 } else {
263 $gcgi->err("Your email sure looks weird...?");
266 not $gcgi->err_check;
269 sub keys_fill {
270 my $self = shift;
271 my ($gcgi) = @_;
272 my $cgi = $gcgi->cgi;
274 $self->{keys} = _trimkeys($cgi->param('keys'));
275 length($self->{keys}) <= 9216
276 or $gcgi->err("The list of keys is more than 9kb. Do you really need that much?");
277 foreach my $key (split /\r?\n/, $self->{keys}) {
278 my ($type, $bits, $fingerprint, $comment);
279 ($type, $bits, $fingerprint, $comment) = sshpub_validate($key)
280 if $key =~ /^ssh-(?:dss|rsa) [0-9A-Za-z+\/=]+ \S+$/;
281 if (!$type) {
282 my $keyval = CGI::escapeHTML($key);
283 my $dsablurb = '';
284 $dsablurb = ' or ssh-dss' unless $Girocco::Config::disable_dsa;
285 $gcgi->err(<<EOT);
286 Your ssh key ("$keyval") appears to have an invalid format
287 (does not start with ssh-rsa$dsablurb or does not end with a whitespace-free comment) -
288 maybe your browser has split a single key onto multiple lines?
290 } elsif ($Girocco::Config::disable_dsa && $type eq 'ssh-dss') {
291 my $keyval = CGI::escapeHTML($key);
292 $gcgi->err(<<EOT);
293 Your ssh key ("$keyval") appears to be of type dsa but only rsa keys are
294 supported - please generate an rsa key (starts with ssh-rsa) and try again
296 } elsif ($bits > 16384) {
297 my $keyval = CGI::escapeHTML($key);
298 $gcgi->err(<<EOT);
299 Your ssh key ("$keyval") appears to have more than 16384 bits, please don't
300 unnecessarily overburden our processors - please limit yourself to keys of
301 16384 bits or less.
303 } elsif ($Girocco::Config::min_key_length && $bits < $Girocco::Config::min_key_length) {
304 my $keyval = CGI::escapeHTML($key);
305 $gcgi->err(<<EOT);
306 Your ssh key ("$keyval") appears to have only $bits bit(s) but at least
307 $Girocco::Config::min_key_length are required - please generate a longer key
312 not $gcgi->err_check;
315 sub keys_save {
316 my $self = shift;
318 $self->_sshkey_save;
321 sub keys_html_list {
322 my $self = shift;
323 my @keys = split(/\r?\n/, $self->{keys});
324 return '' if !@keys;
325 my $html = "<ol>\n";
326 my %types = ('ssh-dss' => 'DSA', 'ssh-rsa' => 'RSA');
327 my $line = 0;
328 foreach (@keys) {
329 ++$line;
330 my ($type, $bits, $fingerprint, $comment) = sshpub_validate($_);
331 next unless $type && $types{$type};
332 my $euser = CGI::escapeHTML(CGI::Util::escape($self->{name}));
333 $html .= "<li>$bits <tt>$fingerprint</tt> ($types{$type}) $comment";
334 $html .= "<br /><a target=\"_blank\" ".
335 "href=\"@{[url_path($Girocco::Config::webadmurl)]}/usercert.cgi/$euser/$line/".
336 $Girocco::Config::nickname."_${euser}_user_$line.pem\">".
337 "download https push user authentication certificate</a> <sup class=\"sup\"><span>".
338 "<a target=\"_blank\" href=\"@{[url_path($Girocco::Config::htmlurl)]}/httpspush.html\">".
339 "(learn more)</a></span></sup>"
340 if $type eq 'ssh-rsa' && $Girocco::Config::httpspushurl &&
341 $Girocco::Config::clientcert &&
342 $Girocco::Config::clientkey;
343 $html .= "</li>\n";
345 $html .= "</ol>\n";
346 return $html;
349 sub gen_auth {
350 my $self = shift;
351 my ($type) = @_;
352 $type = 'REPO' unless $type && $type =~ /^[A-Z]+$/;
354 $self->{authtype} = $type;
355 $self->{auth} = sha1_hex(time . $$ . rand() . $self->{keys});
356 $self->_sshkey_save;
357 $self->{auth};
360 sub del_auth {
361 my $self = shift;
363 delete $self->{auth};
364 delete $self->{authtype};
367 sub get_projects {
368 my $self = shift;
370 return @{$self->{projects}} if defined($self->{projects});
371 my @projects = filedb_atomic_grep(jailed_file('/etc/group'),
372 sub {
373 $_ = $_[0];
374 chomp;
375 my ($group, $users) = (split /:/)[0,3];
376 $group if $users && $users =~ /(^|,)\Q$self->{name}\E(,|$)/;
379 $self->{projects} = \@projects;
380 @{$self->{projects}};
383 sub conjure {
384 my $self = shift;
386 $self->_passwd_add;
387 $self->_sshkey_save;
390 sub remove {
391 my $self = shift;
393 require Girocco::Project;
394 foreach ($self->get_projects) {
395 if (Girocco::Project::does_exist($_, 1)) {
396 my $project = Girocco::Project->load($_);
397 $project->update if $project->remove_user($self->{name});
401 $self->_passwd_remove;
404 ### static methods
406 # Note that 'mob' and 'everyone' are NOT reserved names per se, but they are
407 # names with special semantics and they should be allowed in project membership
408 # lists so they are therefore NOT included in the reservedusernames list.
409 # 'git', 'lock' and 'bundle' are reserved so that the personal mob names 'mob.git',
410 # 'mob.lock' or 'mob.bundle' are not needed as they would be invalid.
411 our %reservedusernames = (
412 root => 1,
413 sshd => 1,
414 _sshd => 1,
415 nobody => 1,
416 lc($Girocco::Config::cgi_user) => 1,
417 lc($Girocco::Config::mirror_user) => 1,
418 git => 1,
419 lock => 1,
420 bundle => 1,
423 sub valid_name {
424 $_ = $_[0];
425 /^[a-zA-Z0-9][a-zA-Z0-9+._-]*$/
426 and (not m#\.\.#)
427 and (not m#\.$#)
428 and (not m#\.git$#i)
429 and (not m#\.lock$#i)
430 and (not m#\.bundle$#i)
431 and (not m#^mob[._]#i)
432 and !exists($reservedusernames{lc($_)})
433 and !has_reserved_suffix($_, $_[1]);
436 sub does_exist {
437 my ($name, $nodie) = @_;
438 if (!Girocco::User::valid_name($name, $Girocco::Config::chroot."/etc/sshkeys")) {
439 die "tried to query for user with invalid name $name!" unless $nodie;
440 return 0;
442 (-e jailed_file("/etc/sshkeys/$name"));
445 sub resolve_uid {
446 my ($name) = @_;
447 $Girocco::Config::chrooted and undef; # TODO for ACLs within chroot
448 scalar(getpwnam($name));