usertool.pl: match recent key length updates
[girocco.git] / toolbox / usertool.pl
blob2495b890c6b7a8b2b83df19ec5c161cb4668e4b5
1 #!/usr/bin/perl
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.
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;
24 exit(&main(@ARGV)||0);
26 our $help;
27 BEGIN {$help = <<'HELP'}
28 Usage: %s [--quiet] <command> <options>
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
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
40 remove [--force] <user>
41 remove user <user>
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
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
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
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
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
70 get [--force] <user> <fieldname>
71 show user <user> field <fieldname>
72 <fieldname> is email|uid|uuid|creationtime|pushtime|keys
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
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";
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]);
114 @keys;
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;
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],
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;
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) {
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],
165 bless $user, "Girocco::User";
166 ($user->{keys}, $user->{auth}, $user->{authtype}) = $user->_sshkey_load
167 if -f jailed_file($user->_sshkey_path);
169 $user || !$force or $user = get_user_forcefully($username);
171 $user = get_user($username) if $load || !defined($user);
172 $user;
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;
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;
195 return $user;
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;
213 closedir $dh;
214 values(%users);
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 }, @_);
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]},
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";
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])) . ')');
255 my $fmtinfo = sub {
256 my @fields = ();
257 if (defined($$_[4])) {
258 $fields[0] = $$_[4];
259 } elsif (defined($$_[5]) || defined($$_[6])) {
260 $fields[0] = "";
262 if (defined($$_[5])) {
263 $fields[1] = $$_[5];
264 } elsif (defined($$_[6])) {
265 $fields[1] = "";
267 $fields[2] = $$_[6] if defined($$_[6]);
268 join(",", @fields);
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);
275 return 0;
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";
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);
309 $keepkeys && -f $kf and ($uobj->{keys}) = $uobj->_sshkey_load;
310 $uobj or die "Could not initialize new user object\n";
311 my $email;
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;
319 warn "Allowing invalid email with --force\n" unless $quiet;
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;
326 warn "Allowing email longer than 96 characters with --force\n" unless $quiet;
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;
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]);
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 "";
360 close $fd;
361 $uobj->remove;
362 warn "Successfully removed user \"$oldname\":\n$old\n" unless $quiet;
363 return 0;
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";
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;
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;
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;
411 return 0;
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]},
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;
448 exists($userslookup{$ARGV[0]}) or die "Unknown user $type: $ARGV[0]\n";
449 push(@users, $userslookup{$ARGV[0]}->[1]);
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;
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;
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;
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;
487 my $old = $user->{email};
488 if (@ARGV == 1) {
489 print "$old\n" if defined($old);
490 return 0;
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;
500 return 0;
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);
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\"";
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;
536 if (length($new) > 9216) {
537 die "The list of keys is more than 9kb. Do you really need that much?\n" unless $force;
538 warn "Allowing keys list of length @{[length($new)]} > 9216 with --force\n" unless $quiet;
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;
553 if ($bits > 16384) {
554 die "max key bits is 16384 but found $bits: $linestart\n" unless $force;
555 warn "Allowing $bits bit key greater than maximum 16384 bits with --force\n" unless $quiet;
557 if ($bits < $minlen) {
558 die "min key bits is $minlen but found $bits: $linestart\n" unless $force;
559 warn "Allowing $bits bit key less than minimum $minlen bits with --force\n" unless $quiet;
562 $user = get_user($ARGV[0]);
563 $user->{keys} = $new;
564 $user->_sshkey_save;
565 warn $user->{name}, ": keys updated to $newname\n" unless $quiet;
566 return 0;
569 our %fieldnames;
570 BEGIN {
571 %fieldnames = (
572 email => [\&cmd_setemail, 0],
573 keys => [\&cmd_setkeys, 0],
574 uid => [\&cmd_getval, 1],
575 uuid => [\&cmd_getval, 1],
576 creationtime => [\&cmd_getval, 1],
577 push => [\&cmd_getval, 1],
578 push_time => [\&cmd_getval, 1],
579 pushtime => [\&cmd_getval, 1],
583 sub do_getset {
584 $setopt = shift;
585 my @newargs = ();
586 push(@newargs, shift) if @_ && $_[0] eq '--force';
587 my $field = $_[1];
588 (($setopt && @_ >= 3) || @_ == 2) && exists($fieldnames{$field}) or die_usage;
589 !$setopt || @_ != 2 || !${$fieldnames{$field}}[1] or die_usage;
590 push(@newargs, shift);
591 shift unless ${$fieldnames{$field}}[1];
592 push(@newargs, @_);
593 diename(($setopt ? "set " : "get ") . $field);
594 @ARGV = @newargs;
595 &{${$fieldnames{$field}}[0]}(@ARGV);
598 sub cmd_get {
599 do_getset(0, @_);
602 sub cmd_set {
603 do_getset(1, @_);
606 our %commands;
607 BEGIN {
608 %commands = (
609 list => \&cmd_list,
610 create => \&cmd_create,
611 remove => \&cmd_remove,
612 delete => \&cmd_remove,
613 show => \&cmd_show,
614 listkeys => \&cmd_listkeys,
615 listprojs => \&cmd_listprojs,
616 listprojects => \&cmd_listprojs,
617 projects => \&cmd_listprojs,
618 setemail => \&cmd_setemail,
619 setkeys => \&cmd_setkeys,
620 get => \&cmd_get,
621 set => \&cmd_set,
625 sub dohelp {
626 my $bn = basename($0);
627 printf "%s version %s\n\n", $bn, $VERSION;
628 printf $help, $bn;
629 exit 0;
632 sub main {
633 local *ARGV = \@_;
634 shift, $quiet=1 if @ARGV && $ARGV[0] =~ /^(?:-q|--quiet)$/i;
635 dohelp if !@ARGV || @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i;
636 my $command = shift;
637 diename($command);
638 $setopt = 1;
639 if (!exists($commands{$command}) && exists($commands{"set".$command})) {
640 $setopt = 0;
641 $command = "set" . $command;
643 exists($commands{$command}) or die "Unknown command \"$command\" -- try \"help\"\n";
644 dohelp if @ARGV && $ARGV[0] =~ /^(?:-h|-?-help|help)$/i && !Girocco::User::does_exist("help",1);
645 &{$commands{$command}}(@ARGV);