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