3 # usertool.pl - command line Girocco user maintenance tool
4 # Copyright (C) 2016,2017 Kyle J. McKay. All rights reserved.
5 # License GPLv2+: GNU GPL version 2 or later.
6 # www.gnu.org/licenses/gpl-2.0.html
7 # This is free software: you are free to change and redistribute it.
8 # There is NO WARRANTY, to the extent permitted by law.
12 use vars
qw($VERSION);
13 BEGIN {*VERSION = \'1.0'}
15 use POSIX qw(strftime);
24 exit(&main
(@ARGV)||0);
27 BEGIN {$help = <<'HELP'}
28 Usage: %s [--quiet] <command> <options>
30 list [--sort=lcname|name|email|uid|push|no] [--email] [<regex>]
31 list all users (default is --sort=lcname)
32 limit to users matching <regex> if given
33 match <regex> against email instead of user name with --email
35 create [--force] [--force] [--keep-keys] [--dry-run] <user>
36 create new user <user>
37 retain pre-existing keys (but not auth) with --keep-keys
38 show all info/warnings but don't actually create with --dry-run
40 remove [--force] <user>
43 show [--force] [--load] [--id] <user>
45 with --load actually load the user forcing a UUID if needed
46 with --id interpret <user> as a uid instead of a name
47 with --force attempt to show normally "invisible" users
49 listkeys [--force] [--verbose] [--urls] [--raw] <user>
50 list user <user> key info
51 with --urls show https push cert download urls if any
52 with --force attempt to show normally "invisible" users
53 with --verbose include public key data (authorized_keys compat)
54 with --raw produce unannotated authorized_keys output
56 listprojs [--regex] [--email] <userinfo>
57 list all push projects that have a user matching <userinfo>
58 match <userinfo> against user email instead of name with --email
59 treat <userinfo> as a regex with --regex
61 [set]email [--force] <user> <newemail>
62 set user <user> email to <newemail>
63 without "set" and only 1 arg, just show current user email
65 [set]keys [--force] <user> <newkeys>
66 set user <user> ssh authorized keys to <newkeys>
67 <newkeys> is -|[@]filename
68 without "set" and only 1 arg, like listkeys --raw
70 get [--force] <user> <fieldname>
71 show user <user> field <fieldname>
72 <fieldname> is email|uid|uuid|creationtime|pushtime|keys
74 set [--force] <user> <fieldname> <newfieldvalue>
75 set user <user> field <fieldname> to <newfieldvalue>
76 <fieldname> is email|keys
77 <newfieldvalue> same as for corresponding set... command
83 my $sub = shift || diename
;
85 die "Invalid arguments to $sub command -- try \"help\"\n";
87 die "Invalid arguments -- try \"help\"\n";
91 # Should be contents of a sshkeys file or {keys} member
92 # return array of arrayref for each key:
93 # [0] = key line number in file
94 # [1] = type either "RSA" or "DSA"
95 # [2] = number of bits in key
96 # [3] = key comment (nickname)
97 # [4] = md5 key fingerprint as shown by ssh-keygen -l
98 # [5] = raw public key line (starting with ssh-... and with comment but no \n)
102 defined($data) or $data = "";
103 my %types = ('ssh-dss' => 'DSA', 'ssh-rsa' => 'RSA');
105 foreach (split(/\n/, Girocco
::User
::_trimkeys
($data))) {
106 if (/^(?:no-pty )?(ssh-(?:dss|rsa) .*)$/) {
109 my ($type, $bits, $fingerprint, $comment) = sshpub_validate
($raw);
110 next unless $type && $types{$type};
111 push(@keys, [$line, $types{$type}, $bits, $comment, $fingerprint, $raw]);
117 sub get_username_for_id
{
119 defined($id) && $id =~ /^-?\d+$/ or return undef;
121 my %usersbyid = map {((0 + $$_[3]) => $_)} get_full_users
;
122 return defined($usersbyid{$id}->[1]) && $usersbyid{$id}->[1] ne "" ?
123 $usersbyid{$id}->[1] : undef;
126 sub get_user_forcefully
{
127 my ($username, $load) = @_;
128 defined($username) && $username ne "" or return undef;
129 my %users = map {($$_[1] => $_)} get_full_users
;
130 exists($users{$username}) && defined($users{$username}->[3]) &&
131 $users{$username}->[3] =~ /^-?\d+$/
132 or die "No such user: \"$username\"\n";
134 my $uref = $users{$username};
138 email
=> $$uref[5]->[0],
139 uuid
=> $$uref[5]->[1],
140 creationtime
=> $$uref[5]->[2],
142 bless $user, "Girocco::User";
143 ($user->{keys}, $user->{auth
}, $user->{authtype
}) = $user->_sshkey_load
144 if -f jailed_file
($user->_sshkey_path);
148 sub get_user_carefully
{
149 my ($username, $load, $force) = @_;
150 defined($username) && $username ne "" or return undef;
151 $force || Girocco
::User
::does_exist
($username, 1) or die "No such user: \"$username\"\n";
155 my %users = map {($$_[1] => $_)} get_all_users
;
156 exists($users{$username}) && $users{$username}->[2] or last;
157 my $uref = $users{$username};
163 creationtime
=> $$uref[6],
165 bless $user, "Girocco::User";
166 ($user->{keys}, $user->{auth
}, $user->{authtype
}) = $user->_sshkey_load
167 if -f jailed_file
($user->_sshkey_path);
169 $user || !$force or $user = get_user_forcefully
($username);
171 $user = get_user
($username) if $load || !defined($user);
176 my $user = get_user_carefully
(@_);
177 delete $user->{email
} unless $user->{email
};
178 delete $user->{uuid
} unless $user->{uuid
};
179 delete $user->{creationtime
} unless $user->{creationtime
};
180 delete $user->{auth
} unless $user->{auth
};
181 delete $user->{authtype
} unless $user->{authtype
};
183 my @keys = key_info_list
($user->{keys});
184 $user->{key_list
} = [map({"$$_[0]: $$_[1] $$_[2] \"$$_[3]\""} @keys)] if @keys;
186 delete $user->{keys};
187 my ($pushuser, $pushtime) = (stat(jailed_file
('/etc/sshactive/'.$user->{name
})))[4,9];
188 if (defined($pushuser) && defined($pushtime)) {
189 $pushuser = $pushuser eq $user->{uid
} ?
'ssh' : 'https';
190 my $jailtime = (stat(jailed_file
('/etc/sshactive/_jailsetup')))[9];
191 $user->{push_access
} = $pushuser if !defined($jailtime) || $pushtime > $jailtime;
192 $pushtime = strftime
("%a %d %b %Y %T %Z", localtime($pushtime));
193 $user->{push_time
} = $pushtime;
198 sub get_all_users_with_push
{
199 my %users = map {($$_[1] => $_)} get_all_users
;
200 my $jailtime = (stat(jailed_file
('/etc/sshactive/_jailsetup')))[9];
201 defined($jailtime) or $jailtime = 0;
202 opendir my $dh, jailed_file
('/etc/sshactive') or die "opendir failed: $!\n";
204 while ($_ = readdir($dh)) {
205 next unless exists $users{$_};
206 my ($pushuser, $pushtime) = (stat(jailed_file
('/etc/sshactive/'.$_)))[4,9];
207 next unless defined($pushuser) && defined($pushtime);
208 $users{$_}->[7] = $pushtime;
210 $pushtype = $pushuser eq $users{$_}->[2] ?
"ssh" : "https" if $pushtime > $jailtime;
211 $users{$_}->[8] = $pushtype;
218 Girocco
::CLIUtil
::_parse_options
(
220 warn((($_[0]eq'?')?
"unrecognized":"missing argument for")." option \"$_[1]\"\n")
228 lcname
=> sub {lc($$a[1]) cmp lc($$b[1])},
229 name
=> sub {$$a[1] cmp $$b[1]},
230 uid
=> sub {$$a[2] <=> $$b[2]},
231 email
=> sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
232 push => sub {($$b[7]||0) <=> ($$a[7]||0) || lc($$a[1]) cmp lc($$b[1])},
233 no => sub {$$a[0] <=> $$b[0]},
235 my $sortopt = 'lcname';
236 my ($verbose, $email);
237 parse_options
(":sort" => \
$sortopt, verbose
=> \
$verbose, email
=> \
$email);
240 my $val = shift @ARGV;
241 $regex = qr
($val) or die "bad regex \"$val\"\n";
243 !@ARGV && exists($sortsub{$sortopt}) or die_usage
;
244 my $sortsub = $sortsub{$sortopt};
245 my $grepsub = defined($regex) ?
($email ?
sub {$$_[4] =~ /$regex/} : sub {$$_[1] =~ /$regex/}) : sub {1};
246 my @users = sort($sortsub grep {&$grepsub} get_all_users_with_push
);
249 return wantarray ?
() : "" unless defined($$u[7]);
250 return (wantarray ?
"" : ' (') . ($$u[8] ?
$$u[8] : "push") .
252 '@' . strftime
("%Y%m%d_%H%M%S%z", localtime($$u[7])) :
253 ' ' . strftime
("%a %d %b %Y %T %Z", localtime($$u[7])) . ')');
257 if (defined($$_[4])) {
259 } elsif (defined($$_[5]) || defined($$_[6])) {
262 if (defined($$_[5])) {
264 } elsif (defined($$_[6])) {
267 $fields[2] = $$_[6] if defined($$_[6]);
271 print map(sprintf("%s\n", join(":", $$_[1], $$_[2], &$fmtinfo, &$fmtpush($_))), @users);
273 print map(sprintf("%s: %s%s\n", $$_[1], $$_[4], scalar(&$fmtpush($_))), @users);
279 my ($force, $keepkeys, $dryrun);
281 parse_options
(force
=> sub{++$force}, "keep-keys" => \
$keepkeys, "dry-run" => \
$dryrun);
282 @ARGV == 1 or die_usage
;
283 my $username = $ARGV[0];
284 $force >= 2 || !Girocco
::User
::does_exist
($username,1) or die "User \"$username\" already exists\n";
285 $force || Girocco
::User
::valid_name
($username) or die "Invalid user name: $username\n";
286 $username =~ /^[a-zA-Z0-9_][a-zA-Z0-9+._-]*$/ or die "Invalid characters in user name: $username\n";
287 my %users = map {($$_[1] => $_)} get_full_users
;
288 !exists($users{$username}) or die "User \"$username\" already has passwd entry\n";
289 my $kf = jailed_file
('/etc/sshkeys/'.$username);
293 -f
$kf and $size = "ing @{[-s $kf]} byte file", $w = 1;
294 if ($force >= 2 && $w) {
295 warn "Ignoring already exist$size: \$chroot/etc/sshkeys/$username\n" unless $quiet;
297 die "Already exist$size: \$chroot/etc/sshkeys/$username\n";
302 # force initialization
303 $uobj = { name
=> $username };
304 bless $uobj, "Girocco::User";
306 # normal "nice" initialization
307 $uobj = Girocco
::User
->ghost($username);
309 $keepkeys && -f
$kf and ($uobj->{keys}) = $uobj->_sshkey_load;
310 $uobj or die "Could not initialize new user object\n";
313 $email = prompt_or_die
("Email/info for user $username");
314 unless (valid_email
($email)) {
316 warn "Your email sure looks weird...?\n";
319 warn "Allowing invalid email with --force\n" unless $quiet;
321 if (length($email) > 96) {
323 warn "Your email is longer than 96 characters. Do you really need that much?\n";
326 warn "Allowing email longer than 96 characters with --force\n" unless $quiet;
329 $uobj->{email
} = $email;
330 my $kcnt = scalar(@
{[split(/\n/, $uobj->{keys}||'')]});
331 warn "Preserved $kcnt key@{[$kcnt==1?'':'s']} from sshkeys file\n" if $kcnt and !$quiet;
332 $uobj->conjure unless $dryrun;
338 parse_options
(force
=> \
$force);
339 @ARGV or die "Please give user name on command line.\n";
340 @ARGV == 1 or die_usage
;
343 my %users = map {($$_[1] => $_)} get_full_users
;
344 exists($users{$ARGV[0]}) or die "User \"$ARGV[0]\" does not have passwd entry\n";
345 $uobj = { name
=> $ARGV[0], uid
=> $users{$ARGV[0]}->[3] };
346 bless $uobj, "Girocco::User";
348 $uobj = get_user_carefully
($ARGV[0]);
350 defined $uobj->{uid
} && $uobj->{uid
} =~ /^\d+/ or die "User \"$ARGV[0]\" failed to load\n";
351 0 + $uobj->{uid
} >= 65540 or die "User \"$ARGV[0]\" with uid $$uobj{uid} < 65540 cannot be removed\n";
353 my $oldname = $uobj->{name
};
354 open my $fd, '<', jailed_file
("/etc/passwd") or die "user remove failed: $!";
355 my $r = qr/^\Q$oldname\E:/;
356 foreach (grep /$r/, <$fd>) {
358 $old = $_ and last if defined($_) && $_ ne "";
362 warn "Successfully removed user \"$oldname\":\n$old\n" unless $quiet;
368 my ($force, $load, $id);
369 parse_options
(force
=> \
$force, load
=> \
$load, id
=> \
$id);
370 @ARGV == 1 or die_usage
;
371 my $username = $ARGV[0];
373 defined($username) && $username =~ /^-?\d+$/ or die "Invalid user id: $username\n";
374 $username = get_username_for_id
($username);
375 defined($username) or die "No such user id: $ARGV[0]\n";
377 my $user = get_clean_user
($username, $load, $force);
379 my $d = Data
::Dumper
->new([\
%info], ['*'.$user->{name
}]);
380 $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
381 print $d->Dump([\
%info], ['*'.$user->{name
}]);
386 my ($force, $verbose, $urls, $raw);
387 parse_options
(force
=> \
$force, verbose
=> \
$verbose, urls
=> \
$urls, raw
=> \
$raw);
388 @ARGV == 1 or die_usage
;
389 my $username = $ARGV[0];
390 my $user = get_user_carefully
($username, 0, $force);
392 my @keys = key_info_list
($user->{keys});
393 $user->{key_info
} = \
@keys if @keys;
394 #$user->{key_desc} = [map({"$$_[0]: $$_[1] $$_[2] \"$$_[3]\""} @keys)] if @keys;
396 $verbose = $urls = 0 if $raw;
397 my $v = $verbose ?
"# " : "";
398 my $vln = $verbose ?
"\n" : "";
399 foreach (@
{$user->{key_info
}}) {
401 my $prefix = $v . (" " x
length("" . $line . ": "));
402 print "$v$$_[0]: $$_[1] $$_[2] \"$$_[3]\"\n" unless $raw;
403 print $prefix, "fingerprint $$_[4]\n" unless $raw;
404 print $prefix, $Girocco::Config
::webadmurl
,
405 "/usercert.cgi/$username/$line/",
406 $Girocco::Config
::nickname
,
407 "_${username}_user_$line.pem", "\n"
408 if $urls && $$_[1] eq "RSA";
409 print $$_[5], "\n$vln" if $verbose || $raw;
416 lcname
=> sub {lc($$a[1]) cmp lc($$b[1])},
417 name
=> sub {$$a[1] cmp $$b[1]},
418 gid
=> sub {$$a[3] <=> $$b[3]},
419 owner
=> sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
420 no => sub {$$a[0] <=> $$b[0]},
422 my ($regex, $email, $sortopt);
424 parse_options
(regex
=> \
$regex, email
=> \
$email, ":sort" => \
$sortopt);
425 exists($sortsub{$sortopt}) or die_usage
;
426 @ARGV == 1 or die_usage
;
428 my @allusers = get_all_users
;
429 push(@allusers, [undef, "everyone"]) unless $email || $regex;
430 push(@allusers, [undef, "mob"]) unless $email || $regex || $Girocco::Config
::mob
ne "mob";
433 my $uregex = qr
($val) or die "bad regex \"$val\"\n";
434 my $select = $email ?
sub {$$_[4] =~ /$uregex/} : sub {$$_[1] =~ /$uregex/};
435 push(@users, map({$$_[1]} grep {&$select} @allusers));
436 @users or $quiet or warn "No matching users found\n";
443 %userslookup = map {($$_[4] => $_)} @allusers;
446 %userslookup = map {($$_[1] => $_)} @allusers;
448 exists($userslookup{$ARGV[0]}) or die "Unknown user $type: $ARGV[0]\n";
449 push(@users, $userslookup{$ARGV[0]}->[1]);
451 my $regexstr = '(?:^|,)' . join("|", map(quotemeta($_), sort @users)) . '(?:,|$)';
452 my $regexcomp = qr/$regexstr/;
453 my $sortsub = $sortsub{$sortopt};
454 my $grepsub = sub {$$_[5] =~ /$regexcomp/};
455 my @projects = sort($sortsub grep {&$grepsub} get_all_projects
);
456 print map(sprintf("%s: %s\n", $$_[1], $$_[5] =~ /^:/ ?
"<mirror>" : $$_[5]), @projects);
462 parse_options
(force
=> \
$force);
463 @ARGV == 2 or die_usage
;
464 my $username = $ARGV[0];
465 my $field = $ARGV[1];
466 $field = "push_time" if $field eq "pushtime" || $field eq "push";
467 my $user = get_clean_user
($username, 0, $force);
468 print $user->{$field}, "\n" if defined($user->{$field});
469 return defined($user->{$field}) ?
0 : 1;
474 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
475 @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage
;
476 my $user = get_user_carefully
($ARGV[0], 0, $force && @ARGV==1);
477 if (@ARGV == 2 && !valid_email
($ARGV[1])) {
478 die "invalid email/info (use --force to accept): \"$ARGV[1]\"\n"
480 warn "using invalid email/info with --force\n" unless $quiet;
482 if (@ARGV == 2 && length($ARGV[1]) > 96) {
483 die "email/info longer than 96 chars (use --force to accept): \"$ARGV[1]\"\n"
485 warn "using longer than 96 char email/info with --force\n" unless $quiet;
487 my $old = $user->{email
};
489 print "$old\n" if defined($old);
492 if (defined($old) && $old eq $ARGV[1]) {
493 warn $user->{name
}, ": skipping update of email/info to same value\n" unless $quiet;
495 $user = get_user
($ARGV[0]);
496 $user->{email
} = $ARGV[1];
497 $user->_passwd_update;
498 warn $user->{name
}, ": email/info updated to \"$ARGV[1]\" (was \"$old\")\n" unless $quiet;
505 shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
506 @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage
;
508 unshift(@ARGV, '--raw');
509 unshift(@ARGV, '--force') if $force;
510 return cmd_listkeys
(@ARGV);
512 my $user = get_user_carefully
($ARGV[0]);
513 my $old = $user->{keys} || "";
515 if ($ARGV[1] eq "-") {
518 $newname = "contents of <STDIN>";
522 die "missing filename for new keys\n" unless $fn ne "";
523 die "no such file: \"$fn\"\n" unless -f
$fn && -r
$fn;
524 open F
, '<', $fn or die "cannot open \"$fn\" for reading: $!\n";
528 $newname = "contents of \"$fn\"";
530 defined($new) or $new = '';
531 $new = Girocco
::User
::_trimkeys
($new);
533 warn $user->{name
}, ": skipping update of keys to same value\n" unless $quiet;
536 if (length($new) > 4096) {
537 die "The list of keys is more than 4kb. Do you really need that much?\n" unless $force;
538 warn "Allowing keys list of length @{[length($new)]} > 4096 with --force\n" unless $quiet;
540 my $minlen = $Girocco::Config
::min_key_length
;
541 defined($minlen) && $minlen =~ /^\d+/ && $minlen >= 512 or $minlen = 512;
542 foreach my $key (split /\r?\n/, $new) {
543 my $linestart = substr($key, 0, 50);
544 $linestart .= "..." if length($linestart) > length($key);
545 my ($type, $bits, $fingerprint, $comment);
546 ($type, $bits, $fingerprint, $comment) = sshpub_validate
($key)
547 if $key =~ /^ssh-(?:dss|rsa) [0-9A-Za-z+\/=]+ \S
+$/;
548 $type or die "Invalid keys line: $linestart\n";
549 if ($Girocco::Config
::disable_dsa
&& $type eq 'ssh-dss') {
550 die "ssh-dss keys are disabled: $linestart\n" unless $force;
551 warn "Allowing disabled ssh-dss key with --force\n" unless $quiet;
553 if ($bits < $minlen) {
554 die "min key bits is $minlen but found $bits: $linestart\n";
555 warn "Allowing $bits bit key less than minimum $minlen bits with --force\n" unless $quiet;
558 $user = get_user
($ARGV[0]);
559 $user->{keys} = $new;
561 warn $user->{name
}, ": keys updated to $newname\n" unless $quiet;
568 email
=> [\
&cmd_setemail
, 0],
569 keys => [\
&cmd_setkeys
, 0],
570 uid
=> [\
&cmd_getval
, 1],
571 uuid
=> [\
&cmd_getval
, 1],
572 creationtime
=> [\
&cmd_getval
, 1],
573 push => [\
&cmd_getval
, 1],
574 push_time
=> [\
&cmd_getval
, 1],
575 pushtime
=> [\
&cmd_getval
, 1],
582 push(@newargs, shift) if @_ && $_[0] eq '--force';
584 (($setopt && @_ >= 3) || @_ == 2) && exists($fieldnames{$field}) or die_usage
;
585 !$setopt || @_ != 2 || !${$fieldnames{$field}}[1] or die_usage
;
586 push(@newargs, shift);
587 shift unless ${$fieldnames{$field}}[1];
589 diename
(($setopt ?
"set " : "get ") . $field);
591 &{${$fieldnames{$field}}[0]}(@ARGV);
606 create
=> \
&cmd_create
,
607 remove
=> \
&cmd_remove
,
608 delete => \
&cmd_remove
,
610 listkeys
=> \
&cmd_listkeys
,
611 listprojs
=> \
&cmd_listprojs
,
612 listprojects
=> \
&cmd_listprojs
,
613 projects
=> \
&cmd_listprojs
,
614 setemail
=> \
&cmd_setemail
,
615 setkeys
=> \
&cmd_setkeys
,
622 my $bn = basename
($0);
623 printf "%s version %s\n\n", $bn, $VERSION;
630 shift, $quiet=1 if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
631 dohelp
if !@ARGV || @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i;
635 if (!exists($commands{$command}) && exists($commands{"set".$command})) {
637 $command = "set" . $command;
639 exists($commands{$command}) or die "Unknown command \"$command\" -- try \"help\"\n";
640 dohelp
if @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i && !Girocco
::User
::does_exist
("help",1);
641 &{$commands{$command}}(@ARGV);