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