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