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