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