Girocco/CLIUtil.pm

   1 # Girocco::CLIUtil.pm -- Command Line Interface Utility Functions
   2 # Copyright (C) 2016 Kyle J. McKay.  All rights reserved.
   3
   4 # This program is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU General Public License
   6 # as published by the Free Software Foundation; either version 2
   7 # of the License, or (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  17
  18 #
  19 ## IMPORTANT
  20 ##
  21 ## This package MUST NOT be used by any CGI script as it cancels
  22 ## the effect of CGI::Carp::fatalsToBrowser which could result in the
  23 ## output of a CGI script becoming unparseable by the web server!
  24 #
  25
  26 package Girocco::CLIUtil;
  27
  28 use strict;
  29 use warnings;
  30
  31 use base qw(Exporter);
  32 our ($VERSION, @EXPORT, @EXPORT_OK);
  33
  34 BEGIN {
  35         @EXPORT = qw(
  36                 diename recreate_file strict_bool
  37                 is_yes is_no is_yesno valid_bool clean_bool
  38                 prompt prompt_or_die
  39                 ynprompt ynprompt_or_die
  40                 prompt_noecho prompt_noecho_or_die
  41                 prompt_noecho_nl prompt_noecho_nl_or_die
  42                 yes_to_continue yes_to_continue_or_die
  43                 get_all_users get_user get_all_projects get_project
  44                 get_full_users nice_me
  45         );
  46         @EXPORT_OK = qw(
  47                 _parse_options _prompt_rl _prompt_rl_or_die
  48                 check_passwd_match _which
  49         );
  50         *VERSION = \'1.0';
  51 }
  52
  53 use File::Basename;
  54 use File::Spec;
  55 use POSIX qw(:fcntl_h);
  56 use Girocco::Config;
  57 use Girocco::Util;
  58 use Girocco::HashUtil;
  59 use Girocco::CGI;
  60 BEGIN {noFatalsToBrowser}
  61
  62 my $have_rl;
  63 BEGIN {eval{
  64         require Term::ReadLine;
  65         $have_rl = 1;
  66 }}
  67
  68 {
  69         package Girocco::CLIUtil::NoEcho;
  70
  71         sub new {
  72                 my $class = shift; # ignored
  73                 my $self = bless {};
  74                 my $fd = shift || 0;
  75                 $self->{fd} = $fd;
  76                 $self->{ios} = POSIX::Termios->new;
  77                 $self->{ios}->getattr($self->{fd});
  78                 my $noecho = POSIX::Termios->new;
  79                 $noecho->getattr($fd);
  80                 $noecho->setlflag($noecho->getlflag & ~(&POSIX::ECHO));
  81                 $noecho->setattr($fd, &POSIX::TCSANOW);
  82                 $self;
  83         }
  84
  85         sub DESTROY {
  86                 my $self = shift;
  87                 $self->{ios}->setattr($self->{fd}, &POSIX::TCSANOW);
  88         }
  89 }
  90
  91 my $diename;
  92 BEGIN {$diename = ""}
  93 sub diename {
  94         my $result = $diename;
  95         $diename = join(" ", @_) if @_;
  96         $result;
  97 }
  98
  99 # Parse Options
 100 #
 101 # Remove any leading options matching the given specs from the @ARGV array and
 102 # store them as indicated.  Parsing stops when an unknown option is encountered,
 103 # "--" is encountered (in which case it's removed) or a non-option is encountered.
 104 # Note that "-" by itself is considered a non-option argument.
 105 #
 106 # Option bundling for single-letter options is NOT supported.
 107 #
 108 # Optional first arg is CODE ref:
 109 #   sub {my ($err, $opt) = @_; ...}
 110 # with $err of '?' meaning $opt is unknown
 111 # with $err of ':' meaning $opt is missing its argument
 112 # $opt is the full option as given on the command line (including leading - etc.)
 113 # the default if omitted dies with an error
 114 # If the sub returns, _parse_options exits immediately with 0
 115 #
 116 # The rest of the arguments form pairs:
 117 #   "spec" => ref
 118 # where ref must be either a SCALAR ref or a CODE ref, if it's neither
 119 # then the "spec" => ref pair is silently ignored.
 120 # "spec" can be:
 121 #   "name"   -- an incrementing flag (matches -name and --name)
 122 #   ":name"  -- an option with a value (matches -name=val and --name=val)
 123 # Using option "--name" matches spec "name" if given otherwise matches spec
 124 # ":name" if given and there's at least one more argument (if not the ':' error
 125 # happens).
 126 # Using option "--name=val" only matches spec ":name" (but "val" can be "").
 127 # For flags, a SCALAR ref is incremented, a CODE ref is called with no arguments.
 128 # For values (":name" specs) a SCALAR ref is assigned the value a CODE ref is
 129 # called with the value as its single argument.
 130 #
 131 # _parse_options returns 1 as long as there were no errors
 132 sub _parse_options {
 133         local $_;
 134         my $failsub = sub {die((($_[0]eq'?')?"unrecognized":"missing argument for")." option \"$_[1]\"\n")};
 135         $failsub = shift if @_ && ref($_[0]) eq "CODE";
 136         my %opts = ();
 137         while (@_ >= 2) {
 138                 if (defined($_[0]) && $_[0] =~ /^:?[^-:\s]/ &&
 139                     defined($_[1]) && (ref($_[1]) eq "SCALAR" || ref($_[1]) eq "CODE")) {
 140                         $opts{$_[0]} = $_[1];
 141                 }
 142                 shift;
 143                 shift;
 144         }
 145         while (@ARGV && $ARGV[0] =~ /^--?[^-:\s]/) {
 146                 my $opt = shift @ARGV;
 147                 my $sopt = $opt;
 148                 $sopt =~ s/^--?//;
 149                 if ($sopt =~ /^([^=]+)=(.*)$/) {
 150                         my ($name, $val) = ($1, $2);
 151                         if ($opts{":$name"}) {
 152                                 ${$opts{":$name"}} = $val if ref($opts{":$name"}) eq "SCALAR";
 153                                 &{$opts{":$name"}}($val) if ref($opts{":$name"}) eq "CODE";
 154                         } else {
 155                                 &$failsub('?', $opt);
 156                                 return 0;
 157                         }
 158                 } elsif ($opts{$sopt}) {
 159                         ++${$opts{$sopt}} if ref($opts{$sopt}) eq "SCALAR";
 160                         &{$opts{$sopt}}() if ref($opts{$sopt}) eq "CODE";
 161                 } elsif ($opts{":$sopt"}) {
 162                         &$failsub(':', $opt),return(0) unless @ARGV;
 163                         my $val = shift @ARGV;
 164                         ${$opts{":$sopt"}} = $val if ref($opts{":$sopt"} eq "SCALAR");
 165                         &{$opts{":$sopt"}}($val) if ref($opts{":$sopt"} eq "CODE");
 166                 } else {
 167                         &$failsub('?', $opt);
 168                         return 0;
 169                 }
 170         }
 171         if (@ARGV && $ARGV[0] eq "--") {
 172                 shift @ARGV;
 173                 return 1;
 174         }
 175         if (@ARGV && $ARGV[0] =~ /^-./) {
 176                 &$failsub('?', $ARGV[0]);
 177                 return 0;
 178         }
 179         return 1;
 180 }
 181
 182 sub recreate_file {
 183         open F, '>', $_[0] or die "failed to create $_[0]: $!\n";
 184         close F;
 185 }
 186
 187 sub is_yes {
 188         my $b = shift;
 189         my $strict = shift;
 190         defined ($b) or $b = "";
 191         return lc($b) eq "yes" || (!$strict && lc($b) eq "y");
 192 }
 193
 194 sub is_no {
 195         my $b = shift;
 196         my $strict = shift;
 197         defined ($b) or $b = "";
 198         return lc($b) eq "no" || (!$strict && lc($b) eq "n");
 199 }
 200
 201 sub is_yesno {
 202         return is_yes(@_) || is_no(@_);
 203 }
 204
 205 my %boolvals;
 206 BEGIN {
 207         %boolvals = (
 208                 true  => 1,
 209                 on    => 1,
 210                 yes   => 1,
 211                 y     => 1,
 212                 1     => 1,
 213
 214                 false => 0,
 215                 off   => 0,
 216                 no    => 0,
 217                 n     => 0,
 218                 0     => 0,
 219         );
 220 }
 221
 222 sub valid_bool {
 223         exists($boolvals{lc($_[0])});
 224 }
 225
 226 sub clean_bool {
 227         my $b = shift || 0;
 228         return $boolvals{lc($b)} || 0;
 229 }
 230
 231 sub _prompt_rl {
 232         my ($norl, $prompt, $default, $promptsfx) = @_;
 233         ! -t STDIN and $norl = 1;
 234         defined($promptsfx) or $promptsfx = ': ';
 235         defined($prompt) or $prompt = '';
 236         my $ds = '';
 237         $ds = " [" . $default . "]" if defined($default);
 238         if ($have_rl && !$norl) {
 239                 my $rl = Term::ReadLine->new(basename($0), \*STDIN, \*STDOUT);
 240                 $rl->ornaments(0);
 241                 $_ = $rl->readline($prompt . $ds . $promptsfx);
 242                 $rl->addhistory($_) if defined($_) && $_ =~ /\S/;
 243         } else {
 244                 print $prompt, $ds, $promptsfx;
 245                 $_ = <STDIN>;
 246         }
 247         return undef unless defined($_);
 248         chomp;
 249         return $_ eq '' && defined($default) ? $default : $_;
 250 }
 251
 252 sub prompt {
 253         return _prompt_rl(undef, @_);
 254 }
 255
 256 sub ynprompt {
 257         my $result;
 258         my @args = @_;
 259         $args[2] = "? " unless defined$args[2];
 260         {
 261                 $result = prompt(@args);
 262                 return undef unless defined($result);
 263                 redo unless is_yesno($result);
 264         }
 265         return clean_bool($result);
 266 }
 267
 268 sub _prompt_rl_or_die {
 269         my $result = _prompt_rl(@_);
 270         unless (defined($result)) {
 271                 my $nm = $diename;
 272                 defined($nm) or $nm = "";
 273                 $nm eq "" or $nm .= " ";
 274                 die "\n${nm}aborted\n";
 275         }
 276         $result;
 277 }
 278
 279 sub prompt_or_die {
 280         return _prompt_rl_or_die(undef, @_);
 281 }
 282
 283 sub ynprompt_or_die {
 284         my $result = ynprompt(@_);
 285         unless (defined($result)) {
 286                 my $nm = $diename;
 287                 defined($nm) or $nm = "";
 288                 $nm eq "" or $nm .= " ";
 289                 die "\n${nm}aborted\n";
 290         }
 291         $result;
 292 }
 293
 294 sub prompt_noecho {
 295         my $ne = Girocco::CLIUtil::NoEcho->new;
 296         _prompt_rl(1, @_);
 297 }
 298
 299 sub prompt_noecho_or_die {
 300         my $ne = Girocco::CLIUtil::NoEcho->new;
 301         _prompt_rl_or_die(1, @_);
 302 }
 303
 304 sub prompt_noecho_nl {
 305         my $result = prompt_noecho(@_);
 306         print "\n";
 307         $result;
 308 }
 309
 310 sub prompt_noecho_nl_or_die {
 311         my $result = prompt_noecho_or_die(@_);
 312         print "\n";
 313         $result;
 314 }
 315
 316 sub yes_to_continue {
 317         return !!ynprompt(($_[0]||"Continue (enter \"yes\" to continue)"), "no");
 318 }
 319
 320 sub yes_to_continue_or_die {
 321         unless (ynprompt_or_die(($_[0]||"Continue (enter \"yes\" to continue)"), "no")) {
 322                 my $nm = $diename;
 323                 defined($nm) or $nm = "";
 324                 $nm .= " " if $nm ne "";
 325                 die "${nm}aborted\n";
 326         }
 327         return 1;
 328 }
 329
 330 my @user_list;
 331 my $user_list_loaded;
 332 my @full_user_list;
 333 my $full_user_list_loaded;
 334
 335 # If single argument is true, return ALL passwd entries not just "...@..." ones
 336 sub _get_all_users_internal {
 337         my $full = shift || 0;
 338         if ($full) {
 339                 return @full_user_list if $full_user_list_loaded;
 340         } else {
 341                 return @user_list if $user_list_loaded;
 342         }
 343         my $passwd_file = jailed_file("/etc/passwd");
 344         open my $fd, '<', $passwd_file or die "could not open \"$passwd_file\": $!\n";
 345         my $line = 0;
 346         my @users;
 347         if ($full) {
 348                 @users = map {/^([^:\s#][^:\s]*):[^:]*:(-?\d+):(-?\d+)(:|$)/
 349                          ? [++$line,split(':',$_,-1)] : ()} <$fd>;
 350         } else {
 351                 @users = map {/^([^:_\s#][^:\s#]*):[^:]+:(\d{5,}):(\d+):([^:,][^:]*)/
 352                          ? [++$line,$1,$2,$3,split(',',$4)] : ()} <$fd>;
 353         }
 354         close $fd;
 355         if ($full) {
 356                 $$_[5] = [split(',', $$_[5])] foreach @users;
 357                 @full_user_list = @users;
 358                 $full_user_list_loaded = 1;
 359         } else {
 360                 @users = grep({$$_[4] =~ /\@/} @users);
 361                 @user_list = @users;
 362                 $user_list_loaded = 1;
 363         }
 364         @users;
 365 }
 366
 367 # Return array of arrayref where each arrayref has:
 368 #   [0] = ordering ordinal from $chroot/etc/passwd
 369 #   [1] = user name
 370 #   [2] = user id number
 371 #   [3] = user group number
 372 #   [4] = user email
 373 #   [5] = user UUID (text as 8x-4x-4x-4x-12x) or undef if none
 374 #   [6] = user creation date as YYYYMMDD_HHMMSS (UTC) or undef if none
 375 sub get_all_users { return _get_all_users_internal; }
 376
 377 # Return array of arrayref where each arrayref has:
 378 #   [0] = ordering ordinal from $chroot/etc/passwd
 379 #   [1] = user name
 380 #   [2] = user password field (usually "x")
 381 #   [3] = user id number
 382 #   [4] = user group number
 383 #   [5] = [info fields] from passwd line (usually email,uuid,creation)
 384 #   [6] = home dir field
 385 #   [7] = shell field
 386 #   [...] possibly more, but [7] is usually max
 387 sub get_full_users { return _get_all_users_internal(1); }
 388
 389 # Result of Girocco::User->load or fatal die if that fails
 390 # Returns undef if passed undef or ""
 391 sub get_user {
 392         my $username = shift;
 393         defined($username) && $username ne "" or return undef;
 394         Girocco::User::does_exist($username, 1) or die "No such user: \"$username\"\n";
 395         my $user;
 396         eval {
 397                 $user = Girocco::User->load($username);
 398                 1;
 399         } && $user->{uid} or die "Could not load user \"$username\"\n";
 400         $user;
 401 }
 402
 403 my @project_list;
 404 my $project_list_loaded;
 405
 406 # Return array of arrayref where each arrayref has:
 407 #   [0] = ordering ordinal from $chroot/etc/group
 408 #   [1] = group name
 409 #   [2] = group password hash
 410 #   [3] = group id number
 411 #   [4] = owner from gitproj.list
 412 #   [5] = list of comma-separated push user names (can be "") or ":" if mirror
 413 sub get_all_projects {
 414         return @project_list if $project_list_loaded;
 415         my $fd;
 416         my $projlist_file = $Girocco::Config::projlist_cache_dir."/gitproj.list";
 417         open $fd, '<', $projlist_file or die "could not open \"$projlist_file\": $!\n";
 418         my $chomper = sub {chomp(my $x = shift); $x;};
 419         my %owners = map {(split(/\s+/, &$chomper($_), 3))[0,2]} <$fd>;
 420         close $fd;
 421         my $group_file = jailed_file("/etc/group");
 422         open $fd, '<', $group_file or die "could not open \"$group_file\": $!\n";
 423         my $line = 0;
 424         my $trimu = sub {
 425                 my $list = shift;
 426                 return ':' if $list =~ /^:/;
 427                 $list =~ s/:.*$//;
 428                 $list;
 429         };
 430         my $defu = sub {defined($_[0])?$_[0]:""};
 431         my @projects = map {/^([^:_\s#][^:\s#]*):([^:]*):(\d{5,}):(.*)$/
 432                             ? [++$line,$1,$2,$3,&$defu($owners{$1}),&$trimu($4)] : ()} <$fd>;
 433         close $fd;
 434         @project_list = @projects;
 435         $project_list_loaded = 1;
 436         @project_list;
 437 }
 438
 439 # Result of Girocco::Project->load or fatal die if that fails
 440 # Returns undef if passed undef or ""
 441 sub get_project {
 442         my $projname = shift;
 443         $projname =~ s/\.git$//i if defined($projname);
 444         defined($projname) && $projname ne "" or return undef;
 445         Girocco::Project::does_exist($projname, 1) or die "No such project: \"$projname\"\n";
 446         my $project;
 447         eval {
 448                 $project = Girocco::Project->load($projname);
 449                 1;
 450         } && $project->{loaded} or die "Could not load project \"$projname\"\n";
 451         $project;
 452 }
 453
 454 # return true if $enc_passwd is a match for $plain_passwd
 455 sub check_passwd_match {
 456         my ($enc_passwd, $plain_passwd) = @_;
 457         defined($enc_passwd) or $enc_passwd = '';
 458         defined($plain_passwd) or $plain_passwd = '';
 459         # $enc_passwd may be crypt or crypt_sha1
 460         if ($enc_passwd =~ m(^\$sha1\$(\d+)\$([./0-9A-Za-z]{1,64})\$[./0-9A-Za-z]{28}$)) {
 461                 # It's using sha1-crypt
 462                 return $enc_passwd eq crypt_sha1($plain_passwd, $2, -(0+$1));
 463         } else {
 464                 # It's using crypt
 465                 return $enc_passwd eq crypt($plain_passwd, $enc_passwd);
 466         }
 467 };
 468
 469 sub _which {
 470         my $cmd = shift;
 471         foreach (File::Spec->path()) {
 472                 my $p = File::Spec->catfile($_, $cmd);
 473                 return $p if -x $p && -f _;
 474         }
 475         return undef;
 476 }
 477
 478 # apply maximum nice and ionice
 479 my $ionice;
 480 sub nice_me {
 481         my $niceval = shift;
 482         if (defined($niceval) && $niceval =~ /^\d+$/ && 0 + $niceval >= 1) {
 483                 my $oldval = POSIX::nice(0);
 484                 POSIX::nice($niceval - $oldval) if $oldval && $niceval > $oldval;
 485         } else {
 486                 POSIX::nice(20);
 487         }
 488         defined($ionice) or $ionice = _which("ionice");
 489         defined($ionice) or $ionice = "";
 490         if ($ionice ne "") {
 491                 my $devnullfd = POSIX::open(File::Spec->devnull, O_RDWR);
 492                 defined($devnullfd) && $devnullfd >= 0 or die "cannot open /dev/null: $!";
 493                 my ($dupin, $dupout, $duperr);
 494                 open $dupin, '<&0' or die "cannot dup STDIN_FILENO: $!";
 495                 open $dupout, '>&1' or die "cannot dup STDOUT_FILENO: $!";
 496                 open $duperr, '>&2' or die "cannot dup STDERR_FILENO: $!";
 497                 POSIX::dup2($devnullfd, 0) or die "cannot dup2 STDIN_FILENO: $!";
 498                 POSIX::dup2($devnullfd, 1) or die "cannot dup2 STDOUT_FILENO: $!";
 499                 POSIX::dup2($devnullfd, 2) or POSIX::dup2(fileno($duperr), 2), die "cannot dup2 STDERR_FILENO: $!";
 500                 POSIX::close($devnullfd);
 501                 system $ionice, "-c", "3", "-p", $$;
 502                 POSIX::dup2(fileno($duperr), 2) or die "cannot dup2 STDERR_FILENO: $!";
 503                 POSIX::dup2(fileno($dupout), 1) or die "cannot dup2 STDOUT_FILENO: $!";
 504                 POSIX::dup2(fileno($dupin), 0) or die "cannot dup2 STDIN_FILENO: $!";
 505                 close $duperr;
 506                 close $dupout;
 507                 close $dupin;
 508         }
 509 }
 510
 511 1;