toolbox/usertool.pl

   1 #!/usr/bin/perl
   2
   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.
   9
  10 use strict;
  11 use warnings;
  12 use vars qw($VERSION);
  13 BEGIN {*VERSION = \'1.0.1'}
  14 use File::Basename;
  15 use POSIX qw(strftime);
  16 use lib "__BASEDIR__";
  17 use Girocco::Config;
  18 use Girocco::Util;
  19 use Girocco::SSHUtil;
  20 use Girocco::CLIUtil;
  21 use Girocco::User;
  22 use Girocco::Project;
  23
  24 exit(&main(@ARGV)||0);
  25
  26 our $help;
  27 BEGIN {$help = <<'HELP'}
  28 Usage: %s [--quiet] <command> <options>
  29
  30        help [<command>]
  31               show full help or just for <command> if given
  32
  33        list [--sort=lcname|name|email|uid|push|no] [--email] [<regex>]
  34               list all users (default is --sort=lcname)
  35               limit to users matching <regex> if given
  36               match <regex> against email instead of user name with --email
  37
  38        create [--force] [--force] [--keep-keys] [--dry-run] <user>
  39               create new user <user>
  40               retain pre-existing keys (but not auth) with --keep-keys
  41               show all info/warnings but don't actually create with --dry-run
  42
  43        remove [--force] <user>
  44               remove user <user>
  45
  46        show [--force] [--load] [--id] <user>
  47               show user <user>
  48               with --load actually load the user forcing a UUID if needed
  49               with --id interpret <user> as a uid instead of a name
  50               with --force attempt to show normally "invisible" users
  51
  52        listkeys [--force] [--verbose] [--urls] [--raw] <user>
  53               list user <user> key info
  54               with --urls show https push cert download urls if any
  55               with --force attempt to show normally "invisible" users
  56               with --verbose include public key data (authorized_keys compat)
  57               with --raw produce unannotated authorized_keys output
  58
  59        listprojs [--regex] [--email] <userinfo>
  60               list all push projects that have a user matching <userinfo>
  61               match <userinfo> against user email instead of name with --email
  62               treat <userinfo> as a regex with --regex
  63
  64        [set]email [--force] <user> <newemail>
  65               set user <user> email to <newemail>
  66               without "set" and only 1 arg, just show current user email
  67
  68        [set]keys [--force] <user> <newkeys>
  69               set user <user> ssh authorized keys to <newkeys>
  70               <newkeys> is -|[@]filename
  71               without "set" and only 1 arg, like listkeys --raw
  72
  73        get [--force] <user> <fieldname>
  74               show user <user> field <fieldname>
  75               <fieldname> is email|uid|uuid|creationtime|pushtime|keys
  76
  77        set [--force] <user> <fieldname> <newfieldvalue>
  78               set user <user> field <fieldname> to <newfieldvalue>
  79               <fieldname> is email|keys
  80               <newfieldvalue> same as for corresponding set... command
  81 HELP
  82
  83 our $quiet;
  84 our $setopt;
  85 sub die_usage {
  86         my $sub = shift || diename;
  87         if ($sub) {
  88                 die "Invalid arguments to $sub command -- try \"help\"\n";
  89         } else {
  90                 die "Invalid arguments -- try \"help\"\n";
  91         }
  92 }
  93
  94 # Should be contents of a sshkeys file or {keys} member
  95 # return array of arrayref for each key:
  96 #   [0] = key line number in file
  97 #   [1] = type either "RSA" or "DSA"
  98 #   [2] = number of bits in key
  99 #   [3] = key comment (nickname)
 100 #   [4] = md5 key fingerprint as shown by ssh-keygen -l -E md5
 101 #   [5] = raw public key line (starting with ssh-... and with comment but no \n)
 102 sub key_info_list {
 103         my $data = shift;
 104         my @keys = ();
 105         defined($data) or $data = "";
 106         my %types = ('ssh-dss' => 'DSA', 'ssh-rsa' => 'RSA');
 107         my $line = 0;
 108         foreach (split(/\n/, Girocco::User::_trimkeys($data))) {
 109                 if (/^(?:no-pty )?(ssh-(?:dss|rsa) .*)$/) {
 110                         ++$line;
 111                         my $raw = $1;
 112                         my ($type, $bits, $fingerprint, $comment) = sshpub_validate($raw);
 113                         next unless $type && $types{$type};
 114                         push(@keys, [$line, $types{$type}, $bits, $comment, $fingerprint, $raw]);
 115                 }
 116         }
 117         @keys;
 118 }
 119
 120 sub get_username_for_id {
 121         my $id = shift;
 122         defined($id) && $id =~ /^-?\d+$/ or return undef;
 123         $id = 0 + $id;
 124         my %usersbyid = map {((0 + $$_[3]) => $_)} get_full_users;
 125         return defined($usersbyid{$id}->[1]) && $usersbyid{$id}->[1] ne "" ?
 126                 $usersbyid{$id}->[1] : undef;
 127 }
 128
 129 sub get_user_forcefully {
 130         my ($username, $load) = @_;
 131         defined($username) && $username ne "" or return undef;
 132         my %users = map {($$_[1] => $_)} get_full_users;
 133         exists($users{$username}) && defined($users{$username}->[3]) &&
 134                 $users{$username}->[3] =~ /^-?\d+$/
 135                 or die "No such user: \"$username\"\n";
 136         my $user;
 137         my $uref = $users{$username};
 138         $user = {
 139                 name  => $username,
 140                 uid   => $$uref[3],
 141                 email => $$uref[5]->[0],
 142                 uuid  => $$uref[5]->[1],
 143                 creationtime => $$uref[5]->[2],
 144         };
 145         bless $user, "Girocco::User";
 146         ($user->{keys}, $user->{auth}, $user->{authtype}) = $user->_sshkey_load
 147                 if -f jailed_file($user->_sshkey_path);
 148         $user;
 149 }
 150
 151 sub get_user_carefully {
 152         my ($username, $load, $force) = @_;
 153         defined($username) && $username ne "" or return undef;
 154         $force || Girocco::User::does_exist($username, 1) or die "No such user: \"$username\"\n";
 155         my $user;
 156         if (!$load) {
 157                 {
 158                         my %users = map {($$_[1] => $_)} get_all_users;
 159                         exists($users{$username}) && $users{$username}->[2] or last;
 160                         my $uref = $users{$username};
 161                         $user = {
 162                                 name  => $username,
 163                                 uid   => $$uref[2],
 164                                 email => $$uref[4],
 165                                 uuid  => $$uref[5],
 166                                 creationtime => $$uref[6],
 167                         };
 168                         bless $user, "Girocco::User";
 169                         ($user->{keys}, $user->{auth}, $user->{authtype}) = $user->_sshkey_load
 170                                 if -f jailed_file($user->_sshkey_path);
 171                 }
 172                 $user || !$force or $user = get_user_forcefully($username);
 173         }
 174         $user = get_user($username) if $load || !defined($user);
 175         $user;
 176 }
 177
 178 sub get_clean_user {
 179         my $user = get_user_carefully(@_);
 180         delete $user->{email} unless $user->{email};
 181         delete $user->{uuid} unless $user->{uuid};
 182         delete $user->{creationtime} unless $user->{creationtime};
 183         delete $user->{auth} unless $user->{auth};
 184         delete $user->{authtype} unless $user->{authtype};
 185         if ($user->{keys}) {
 186                 my @keys = key_info_list($user->{keys});
 187                 $user->{key_list} = [map({"$$_[0]: $$_[1] $$_[2] \"$$_[3]\""} @keys)] if @keys;
 188         }
 189         delete $user->{keys};
 190         my ($pushuser, $pushtime) = (stat(jailed_file('/etc/sshactive/'.$user->{name})))[4,9];
 191         if (defined($pushuser) && defined($pushtime)) {
 192                 $pushuser = $pushuser eq $user->{uid} ? 'ssh' : 'https';
 193                 my $jailtime = (stat(jailed_file('/etc/sshactive/_jailsetup')))[9];
 194                 $user->{push_access} = $pushuser if !defined($jailtime) || $pushtime > $jailtime;
 195                 $pushtime = strftime("%a %d %b %Y %T %Z", localtime($pushtime));
 196                 $user->{push_time} = $pushtime;
 197         }
 198         return $user;
 199 }
 200
 201 sub get_all_users_with_push {
 202         my %users = map {($$_[1] => $_)} get_all_users;
 203         my $jailtime = (stat(jailed_file('/etc/sshactive/_jailsetup')))[9];
 204         defined($jailtime) or $jailtime = 0;
 205         opendir my $dh, jailed_file('/etc/sshactive') or die "opendir failed: $!\n";
 206         local $_;
 207         while ($_ = readdir($dh)) {
 208                 next unless exists $users{$_};
 209                 my ($pushuser, $pushtime) = (stat(jailed_file('/etc/sshactive/'.$_)))[4,9];
 210                 next unless defined($pushuser) && defined($pushtime);
 211                 $users{$_}->[7] = $pushtime;
 212                 my $pushtype = '';
 213                 $pushtype = $pushuser eq $users{$_}->[2] ? "ssh" : "https" if $pushtime > $jailtime;
 214                 $users{$_}->[8] = $pushtype;
 215         }
 216         closedir $dh;
 217         values(%users);
 218 }
 219
 220 sub parse_options {
 221         Girocco::CLIUtil::_parse_options(
 222                 sub {
 223                         warn((($_[0]eq'?')?"unrecognized":"missing argument for")." option \"$_[1]\"\n")
 224                                 unless $quiet;
 225                         die_usage;
 226                 }, @_);
 227 }
 228
 229 sub cmd_list {
 230         my %sortsub = (
 231                 lcname => sub {lc($$a[1]) cmp lc($$b[1])},
 232                 name => sub {$$a[1] cmp $$b[1]},
 233                 uid => sub {$$a[2] <=> $$b[2]},
 234                 email => sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
 235                 push => sub {($$b[7]||0) <=> ($$a[7]||0) || lc($$a[1]) cmp lc($$b[1])},
 236                 no => sub {$$a[0] <=> $$b[0]},
 237         );
 238         my $sortopt = 'lcname';
 239         my ($verbose, $email);
 240         parse_options(":sort" => \$sortopt, verbose => \$verbose, email => \$email);
 241         my $regex;
 242         if (@ARGV) {
 243                 my $val = shift @ARGV;
 244                 $regex = qr($val) or die "bad regex \"$val\"\n";
 245         }
 246         !@ARGV && exists($sortsub{$sortopt}) or die_usage;
 247         my $sortsub = $sortsub{$sortopt};
 248         my $grepsub = defined($regex) ? ($email ? sub {$$_[4] =~ /$regex/} : sub {$$_[1] =~ /$regex/}) : sub {1};
 249         my @users = sort($sortsub grep {&$grepsub} get_all_users_with_push);
 250         my $fmtpush = sub {
 251                 my $u = shift;
 252                 return wantarray ? () : "" unless defined($$u[7]);
 253                 return (wantarray ? "" : ' (') . ($$u[8] ? $$u[8] : "push") .
 254                         (wantarray ?
 255                                 '@' . strftime("%Y%m%d_%H%M%S%z", localtime($$u[7])) :
 256                                 ' ' . strftime("%a %d %b %Y %T %Z", localtime($$u[7])) . ')');
 257         };
 258         my $fmtinfo = sub {
 259                 my @fields = ();
 260                 if (defined($$_[4])) {
 261                         $fields[0] = $$_[4];
 262                 } elsif (defined($$_[5]) || defined($$_[6])) {
 263                         $fields[0] = "";
 264                 }
 265                 if (defined($$_[5])) {
 266                         $fields[1] = $$_[5];
 267                 } elsif (defined($$_[6])) {
 268                         $fields[1] = "";
 269                 }
 270                 $fields[2] = $$_[6] if defined($$_[6]);
 271                 join(",", @fields);
 272         };
 273         if ($verbose) {
 274                 print map(sprintf("%s\n", join(":", $$_[1], $$_[2], &$fmtinfo, &$fmtpush($_))), @users);
 275         } else {
 276                 print map(sprintf("%s: %s%s\n", $$_[1], $$_[4], scalar(&$fmtpush($_))), @users);
 277         }
 278         return 0;
 279 }
 280
 281 sub cmd_create {
 282         my ($force, $keepkeys, $dryrun);
 283         $force = 0;
 284         parse_options(force => sub{++$force}, "keep-keys" => \$keepkeys, "dry-run" => \$dryrun);
 285         @ARGV == 1 or die_usage;
 286         my $username = $ARGV[0];
 287         $force >= 2 || !Girocco::User::does_exist($username,1) or die "User \"$username\" already exists\n";
 288         $force || Girocco::User::valid_name($username) or die "Invalid user name: $username\n";
 289         $username =~ /^[a-zA-Z0-9_][a-zA-Z0-9+._-]*$/ or die "Invalid characters in user name: $username\n";
 290         my %users = map {($$_[1] => $_)} get_full_users;
 291         !exists($users{$username}) or die "User \"$username\" already has passwd entry\n";
 292         my $kf = jailed_file('/etc/sshkeys/'.$username);
 293         if (-e $kf) {
 294                 my $size = "s";
 295                 my $w = 0;
 296                 -f $kf and $size = "ing @{[-s $kf]} byte file", $w = 1;
 297                 if ($force >= 2 && $w) {
 298                         warn "Ignoring already exist$size: \$chroot/etc/sshkeys/$username\n" unless $quiet;
 299                 } else {
 300                         die "Already exist$size: \$chroot/etc/sshkeys/$username\n";
 301                 }
 302         }
 303         my $uobj;
 304         if ($force) {
 305                 # force initialization
 306                 $uobj = { name => $username };
 307                 bless $uobj, "Girocco::User";
 308         } else {
 309                 # normal "nice" initialization
 310                 $uobj = Girocco::User->ghost($username);
 311         }
 312         $keepkeys && -f $kf and ($uobj->{keys}) = $uobj->_sshkey_load;
 313         $uobj or die "Could not initialize new user object\n";
 314         my $email;
 315         {
 316                 $email = prompt_or_die("Email/info for user $username");
 317                 unless (valid_email($email)) {
 318                         unless ($force) {
 319                                 warn "Your email sure looks weird...?\n";
 320                                 redo;
 321                         }
 322                         warn "Allowing invalid email with --force\n" unless $quiet;
 323                 }
 324                 if (length($email) > 96) {
 325                         unless ($force) {
 326                                 warn "Your email is longer than 96 characters.  Do you really need that much?\n";
 327                                 redo;
 328                         }
 329                         warn "Allowing email longer than 96 characters with --force\n" unless $quiet;
 330                 }
 331         }
 332         $uobj->{email} = $email;
 333         my $kcnt = scalar(@{[split(/\n/, $uobj->{keys}||'')]});
 334         warn "Preserved $kcnt key@{[$kcnt==1?'':'s']} from sshkeys file\n" if $kcnt and !$quiet;
 335         $uobj->conjure unless $dryrun;
 336         return 0;
 337 }
 338
 339 sub cmd_remove {
 340         my ($force);
 341         parse_options(force => \$force);
 342         @ARGV or die "Please give user name on command line.\n";
 343         @ARGV == 1 or die_usage;
 344         my $uobj;
 345         if ($force) {
 346                 my %users = map {($$_[1] => $_)} get_full_users;
 347                 exists($users{$ARGV[0]}) or die "User \"$ARGV[0]\" does not have passwd entry\n";
 348                 $uobj = { name => $ARGV[0], uid => $users{$ARGV[0]}->[3] };
 349                 bless $uobj, "Girocco::User";
 350         } else {
 351                 $uobj = get_user_carefully($ARGV[0]);
 352         }
 353         defined $uobj->{uid} && $uobj->{uid} =~ /^\d+/ or die "User \"$ARGV[0]\" failed to load\n";
 354         0 + $uobj->{uid} >= 65540 or die "User \"$ARGV[0]\" with uid $$uobj{uid} < 65540 cannot be removed\n";
 355         my $old;
 356         my $oldname = $uobj->{name};
 357         open my $fd, '<', jailed_file("/etc/passwd") or die "user remove failed: $!";
 358         my $r = qr/^\Q$oldname\E:/;
 359         foreach (grep /$r/, <$fd>) {
 360                 chomp;
 361                 $old = $_ and last if defined($_) && $_ ne "";
 362         }
 363         close $fd;
 364         $uobj->remove;
 365         warn "Successfully removed user \"$oldname\":\n$old\n" unless $quiet;
 366         return 0;
 367 }
 368
 369 sub cmd_show {
 370         use Data::Dumper;
 371         my ($force, $load, $id);
 372         parse_options(force => \$force, load => \$load, id => \$id);
 373         @ARGV == 1 or die_usage;
 374         my $username = $ARGV[0];
 375         if ($id) {
 376                 defined($username) && $username =~ /^-?\d+$/ or die "Invalid user id: $username\n";
 377                 $username = get_username_for_id($username);
 378                 defined($username) or die "No such user id: $ARGV[0]\n";
 379         }
 380         my $user = get_clean_user($username, $load, $force);
 381         my %info = %$user;
 382         my $d = Data::Dumper->new([\%info], ['*'.$user->{name}]);
 383         $d->Sortkeys(sub {[sort({lc($a) cmp lc($b)} keys %{$_[0]})]});
 384         print $d->Dump([\%info], ['*'.$user->{name}]);
 385         return 0;
 386 }
 387
 388 sub cmd_listkeys {
 389         my ($force, $verbose, $urls, $raw);
 390         parse_options(force => \$force, verbose => \$verbose, urls => \$urls, raw => \$raw);
 391         @ARGV == 1 or die_usage;
 392         my $username = $ARGV[0];
 393         my $user = get_user_carefully($username, 0, $force);
 394         if ($user->{keys}) {
 395                 my @keys = key_info_list($user->{keys});
 396                 $user->{key_info} = \@keys if @keys;
 397                 #$user->{key_desc} = [map({"$$_[0]: $$_[1] $$_[2] \"$$_[3]\""} @keys)] if @keys;
 398         }
 399         $verbose = $urls = 0 if $raw;
 400         my $v = $verbose ? "# " : "";
 401         my $vln = $verbose ? "\n" : "";
 402         foreach (@{$user->{key_info}}) {
 403                 my $line = $$_[0];
 404                 my $prefix = $v . (" " x length("" . $line . ": "));
 405                 print "$v$$_[0]: $$_[1] $$_[2] \"$$_[3]\"\n" unless $raw;
 406                 print $prefix, "fingerprint $$_[4]\n" unless $raw;
 407                 print $prefix, $Girocco::Config::webadmurl,
 408                         "/usercert.cgi/$username/$line/",
 409                         $Girocco::Config::nickname,
 410                         "_${username}_user_$line.pem", "\n"
 411                         if $urls && $$_[1] eq "RSA";
 412                 print $$_[5], "\n$vln" if $verbose || $raw;
 413         }
 414         return 0;
 415 }
 416
 417 sub cmd_listprojs {
 418         my %sortsub = (
 419                 lcname => sub {lc($$a[1]) cmp lc($$b[1])},
 420                 name => sub {$$a[1] cmp $$b[1]},
 421                 gid => sub {$$a[3] <=> $$b[3]},
 422                 owner => sub {lc($$a[4]) cmp lc($$b[4]) || lc($$a[1]) cmp lc($$b[1])},
 423                 no => sub {$$a[0] <=> $$b[0]},
 424         );
 425         my ($regex, $email, $sortopt);
 426         $sortopt = 'lcname';
 427         parse_options(regex => \$regex, email => \$email, ":sort" => \$sortopt);
 428         exists($sortsub{$sortopt}) or die_usage;
 429         @ARGV == 1 or die_usage;
 430         my @users = ();
 431         my @allusers = get_all_users;
 432         push(@allusers, [undef, "everyone"]) unless $email || $regex;
 433         push(@allusers, [undef, "mob"]) unless $email || $regex || $Girocco::Config::mob ne "mob";
 434         if ($regex) {
 435                 my $val = $ARGV[0];
 436                 my $uregex = qr($val) or die "bad regex \"$val\"\n";
 437                 my $select = $email ? sub {$$_[4] =~ /$uregex/} : sub {$$_[1] =~ /$uregex/};
 438                 push(@users, map({$$_[1]} grep {&$select} @allusers));
 439                 @users or $quiet or warn "No matching users found\n";
 440                 @users or return 0;
 441         } else {
 442                 my $type;
 443                 my %userslookup;
 444                 if ($email) {
 445                         $type = "email";
 446                         %userslookup = map {($$_[4] => $_)} @allusers;
 447                 } else {
 448                         $type = "name";
 449                         %userslookup = map {($$_[1] => $_)} @allusers;
 450                 }
 451                 exists($userslookup{$ARGV[0]}) or die "Unknown user $type: $ARGV[0]\n";
 452                 push(@users, $userslookup{$ARGV[0]}->[1]);
 453         }
 454         my $regexstr = '(?:^|,)' . join("|", map(quotemeta($_), sort @users)) . '(?:,|$)';
 455         my $regexcomp = qr/$regexstr/;
 456         my $sortsub = $sortsub{$sortopt};
 457         my $grepsub = sub {$$_[5] =~ /$regexcomp/};
 458         my @projects = sort($sortsub grep {&$grepsub} get_all_projects);
 459         print map(sprintf("%s: %s\n", $$_[1], $$_[5] =~ /^:/ ? "<mirror>" : $$_[5]), @projects);
 460         return 0;
 461 }
 462
 463 sub cmd_getval {
 464         my ($force);
 465         parse_options(force => \$force);
 466         @ARGV == 2 or die_usage;
 467         my $username = $ARGV[0];
 468         my $field = $ARGV[1];
 469         $field = "push_time" if $field eq "pushtime" || $field eq "push";
 470         my $user = get_clean_user($username, 0, $force);
 471         print $user->{$field}, "\n" if defined($user->{$field});
 472         return defined($user->{$field}) ? 0 : 1;
 473 }
 474
 475 sub cmd_setemail {
 476         my $force = 0;
 477         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
 478         @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
 479         my $user = get_user_carefully($ARGV[0], 0, $force && @ARGV==1);
 480         if (@ARGV == 2 && !valid_email($ARGV[1])) {
 481                 die "invalid email/info (use --force to accept): \"$ARGV[1]\"\n"
 482                         unless $force;
 483                 warn "using invalid email/info with --force\n" unless $quiet;
 484         }
 485         if (@ARGV == 2 && length($ARGV[1]) > 96) {
 486                 die "email/info longer than 96 chars (use --force to accept): \"$ARGV[1]\"\n"
 487                         unless $force;
 488                 warn "using longer than 96 char email/info with --force\n" unless $quiet;
 489         }
 490         my $old = $user->{email};
 491         if (@ARGV == 1) {
 492                 print "$old\n" if defined($old);
 493                 return 0;
 494         }
 495         if (defined($old) && $old eq $ARGV[1]) {
 496                 warn $user->{name}, ": skipping update of email/info to same value\n" unless $quiet;
 497         } else {
 498                 $user = get_user($ARGV[0]);
 499                 $user->{email} = $ARGV[1];
 500                 $user->_passwd_update;
 501                 warn $user->{name}, ": email/info updated to \"$ARGV[1]\" (was \"$old\")\n" unless $quiet;
 502         }
 503         return 0;
 504 }
 505
 506 sub cmd_setkeys {
 507         my $force = 0;
 508         shift(@ARGV), $force=1 if @ARGV && $ARGV[0] eq '--force';
 509         @ARGV == 2 || (@ARGV == 1 && !$setopt) or die_usage;
 510         if (@ARGV == 1) {
 511                 unshift(@ARGV, '--raw');
 512                 unshift(@ARGV, '--force') if $force;
 513                 return cmd_listkeys(@ARGV);
 514         }
 515         my $user = get_user_carefully($ARGV[0]);
 516         my $old = $user->{keys} || "";
 517         my ($new, $newname);
 518         if ($ARGV[1] eq "-") {
 519                 local $/;
 520                 $new = <STDIN>;
 521                 $newname = "contents of <STDIN>";
 522         } else {
 523                 my $fn = $ARGV[1];
 524                 $fn =~ s/^\@//;
 525                 die "missing filename for new keys\n" unless $fn ne "";
 526                 die "no such file: \"$fn\"\n" unless -f $fn && -r $fn;
 527                 open F, '<', $fn or die "cannot open \"$fn\" for reading: $!\n";
 528                 local $/;
 529                 $new = <F>;
 530                 close F;
 531                 $newname = "contents of \"$fn\"";
 532         }
 533         defined($new) or $new = '';
 534         $new = Girocco::User::_trimkeys($new);
 535         if ($old eq $new) {
 536                 warn $user->{name}, ": skipping update of keys to same value\n" unless $quiet;
 537                 return 0;
 538         }
 539         if (length($new) > 9216) {
 540                 die "The list of keys is more than 9kb. Do you really need that much?\n" unless $force;
 541                 warn "Allowing keys list of length @{[length($new)]} > 9216 with --force\n" unless $quiet;
 542         }
 543         my $minlen = $Girocco::Config::min_key_length;
 544         defined($minlen) && $minlen =~ /^\d+/ && $minlen >= 512 or $minlen = 512;
 545         foreach my $key (split /\r?\n/, $new) {
 546                 my $linestart = substr($key, 0, 50);
 547                 $linestart .= "..." if length($linestart) > length($key);
 548                 my ($type, $bits, $fingerprint, $comment);
 549                 ($type, $bits, $fingerprint, $comment) = sshpub_validate($key)
 550                         if $key =~ /^ssh-(?:dss|rsa) [0-9A-Za-z+\/=]+ \S+$/;
 551                 $type or die "Invalid keys line: $linestart\n";
 552                 if ($Girocco::Config::disable_dsa && $type eq 'ssh-dss') {
 553                         die "ssh-dss keys are disabled: $linestart\n" unless $force;
 554                         warn "Allowing disabled ssh-dss key with --force\n" unless $quiet;
 555                 }
 556                 if ($bits > 16384) {
 557                         die "max key bits is 16384 but found $bits: $linestart\n" unless $force;
 558                         warn "Allowing $bits bit key greater than maximum 16384 bits with --force\n" unless $quiet;
 559                 }
 560                 if ($bits < $minlen) {
 561                         die "min key bits is $minlen but found $bits: $linestart\n" unless $force;
 562                         warn "Allowing $bits bit key less than minimum $minlen bits with --force\n" unless $quiet;
 563                 }
 564         }
 565         $user = get_user($ARGV[0]);
 566         $user->{keys} = $new;
 567         $user->_sshkey_save;
 568         warn $user->{name}, ": keys updated to $newname\n" unless $quiet;
 569         return 0;
 570 }
 571
 572 our %fieldnames;
 573 BEGIN {
 574         %fieldnames = (
 575                 email         => [\&cmd_setemail,  0],
 576                 keys          => [\&cmd_setkeys,   0],
 577                 uid           => [\&cmd_getval,    1],
 578                 uuid          => [\&cmd_getval,    1],
 579                 creationtime  => [\&cmd_getval,    1],
 580                 push          => [\&cmd_getval,    1],
 581                 push_time     => [\&cmd_getval,    1],
 582                 pushtime      => [\&cmd_getval,    1],
 583         );
 584 }
 585
 586 sub do_getset {
 587         $setopt = shift;
 588         my @newargs = ();
 589         push(@newargs, shift) if @_ && $_[0] eq '--force';
 590         my $field = $_[1];
 591         (($setopt && @_ >= 3) || @_ == 2) && exists($fieldnames{$field}) or die_usage;
 592         !$setopt || @_ != 2 || !${$fieldnames{$field}}[1] or die_usage;
 593         push(@newargs, shift);
 594         shift unless ${$fieldnames{$field}}[1];
 595         push(@newargs, @_);
 596         diename(($setopt ? "set " : "get ") . $field);
 597         @ARGV = @newargs;
 598         &{${$fieldnames{$field}}[0]}(@ARGV);
 599 }
 600
 601 sub cmd_get {
 602         do_getset(0, @_);
 603 }
 604
 605 sub cmd_set {
 606         do_getset(1, @_);
 607 }
 608
 609 our %commands;
 610 BEGIN {
 611         %commands = (
 612                 list => \&cmd_list,
 613                 create => \&cmd_create,
 614                 remove => \&cmd_remove,
 615                 delete => \&cmd_remove,
 616                 show => \&cmd_show,
 617                 listkeys => \&cmd_listkeys,
 618                 listprojs => \&cmd_listprojs,
 619                 listprojects => \&cmd_listprojs,
 620                 projects => \&cmd_listprojs,
 621                 setemail => \&cmd_setemail,
 622                 setkeys => \&cmd_setkeys,
 623                 get => \&cmd_get,
 624                 set => \&cmd_set,
 625         );
 626 }
 627
 628 sub dohelp {
 629         my $cmd = shift;
 630         my $bn = basename($0);
 631         printf "%s version %s\n\n", $bn, $VERSION;
 632         if (defined($cmd) && $cmd ne '') {
 633                 $cmd =~ s/^set(?=[a-zA-Z])//i;
 634                 my $cmdhelp = '';
 635                 my ($lastmt, $incmd);
 636                 foreach (split('\n', sprintf($help, $bn))) {
 637                         $lastmt || $incmd or $lastmt = /^\s*$/, next;
 638                         $incmd = 1 if $lastmt && /^\s*(?:\[?set\]?)?$cmd\s/;
 639                         last if $incmd && /^\s*$/;
 640                         $incmd and $cmdhelp .= $_ . "\n";
 641                         $lastmt = /^\s*$/;
 642                 }
 643                 print $cmdhelp and exit 0 if $cmdhelp;
 644         }
 645         printf $help, $bn;
 646         exit 0;
 647 }
 648
 649 sub main {
 650         local *ARGV = \@_;
 651         shift, $quiet=1 if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
 652         dohelp($ARGV[1]) if !@ARGV || @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i;
 653         my $command = shift;
 654         diename($command);
 655         $setopt = 1;
 656         if (!exists($commands{$command}) && exists($commands{"set".$command})) {
 657                 $setopt = 0;
 658                 $command = "set" . $command;
 659         }
 660         exists($commands{$command}) or die "Unknown command \"$command\" -- try \"help\"\n";
 661         dohelp($command) if @ARGV && ($ARGV[0] =~ /^(?:-h|-?-help)$/i ||
 662                 $ARGV[0] =~ /^help$/i && !Girocco::User::does_exist("help",1));
 663         &{$commands{$command}}(@ARGV);
 664 }