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