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 setup_pager setup_pager_stdout
  45                 pager_in_use
  46         );
  47         @EXPORT_OK = qw(
  48                 _parse_options _prompt_rl _prompt_rl_or_die
  49                 check_passwd_match _which
  50         );
  51         *VERSION = \'1.0';
  52 }
  53
  54 use File::Basename;
  55 use File::Spec;
  56 use POSIX qw(:fcntl_h);
  57 use Girocco::Config;
  58 use Girocco::Util;
  59 use Girocco::HashUtil;
  60 use Girocco::CGI;
  61 BEGIN {noFatalsToBrowser}
  62
  63 my $have_rl;
  64 BEGIN {eval{
  65         require Term::ReadLine;
  66         $have_rl = 1;
  67 }}
  68
  69 {
  70         package Girocco::CLIUtil::NoEcho;
  71
  72         sub new {
  73                 my $class = shift; # ignored
  74                 my $self = bless {};
  75                 my $fd = shift || 0;
  76                 $self->{fd} = $fd;
  77                 $self->{ios} = POSIX::Termios->new;
  78                 $self->{ios}->getattr($self->{fd});
  79                 my $noecho = POSIX::Termios->new;
  80                 $noecho->getattr($fd);
  81                 $noecho->setlflag($noecho->getlflag & ~(&POSIX::ECHO));
  82                 $noecho->setattr($fd, &POSIX::TCSANOW);
  83                 $self;
  84         }
  85
  86         sub DESTROY {
  87                 my $self = shift;
  88                 $self->{ios}->setattr($self->{fd}, &POSIX::TCSANOW);
  89         }
  90 }
  91
  92 my $diename;
  93 BEGIN {$diename = ""}
  94 sub diename {
  95         my $result = $diename;
  96         $diename = join(" ", @_) if @_;
  97         $result;
  98 }
  99
 100 # Parse Options
 101 #
 102 # Remove any leading options matching the given specs from the @ARGV array and
 103 # store them as indicated.  Parsing stops when an unknown option is encountered,
 104 # "--" is encountered (in which case it's removed) or a non-option is encountered.
 105 # Note that "-" by itself is considered a non-option argument.
 106 #
 107 # Option bundling for single-letter options is NOT supported.
 108 #
 109 # Optional first arg is CODE ref:
 110 #   sub {my ($err, $opt) = @_; ...}
 111 # with $err of '?' meaning $opt is unknown
 112 # with $err of ':' meaning $opt is missing its argument
 113 # $opt is the full option as given on the command line (including leading - etc.)
 114 # the default if omitted dies with an error
 115 # If the sub returns, _parse_options exits immediately with 0
 116 #
 117 # The rest of the arguments form pairs:
 118 #   "spec" => ref
 119 # where ref must be either a SCALAR ref or a CODE ref, if it's neither
 120 # then the "spec" => ref pair is silently ignored.
 121 # "spec" can be:
 122 #   "name"   -- an incrementing flag (matches -name and --name)
 123 #   ":name"  -- an option with a value (matches -name=val and --name=val)
 124 # Using option "--name" matches spec "name" if given otherwise matches spec
 125 # ":name" if given and there's at least one more argument (if not the ':' error
 126 # happens).
 127 # Using option "--name=val" only matches spec ":name" (but "val" can be "").
 128 # For flags, a SCALAR ref is incremented, a CODE ref is called with no arguments.
 129 # For values (":name" specs) a SCALAR ref is assigned the value a CODE ref is
 130 # called with the value as its single argument.
 131 #
 132 # _parse_options returns 1 as long as there were no errors
 133 sub _parse_options {
 134         local $_;
 135         my $failsub = sub {die((($_[0]eq'?')?"unrecognized":"missing argument for")." option \"$_[1]\"\n")};
 136         $failsub = shift if @_ && ref($_[0]) eq "CODE";
 137         my %opts = ();
 138         while (@_ >= 2) {
 139                 if (defined($_[0]) && $_[0] =~ /^:?[^-:\s]/ &&
 140                     defined($_[1]) && (ref($_[1]) eq "SCALAR" || ref($_[1]) eq "CODE")) {
 141                         $opts{$_[0]} = $_[1];
 142                 }
 143                 shift;
 144                 shift;
 145         }
 146         while (@ARGV && $ARGV[0] =~ /^--?[^-:\s]/) {
 147                 my $opt = shift @ARGV;
 148                 my $sopt = $opt;
 149                 $sopt =~ s/^--?//;
 150                 if ($sopt =~ /^([^=]+)=(.*)$/) {
 151                         my ($name, $val) = ($1, $2);
 152                         if ($opts{":$name"}) {
 153                                 ${$opts{":$name"}} = $val if ref($opts{":$name"}) eq "SCALAR";
 154                                 &{$opts{":$name"}}($val) if ref($opts{":$name"}) eq "CODE";
 155                         } else {
 156                                 &$failsub('?', $opt);
 157                                 return 0;
 158                         }
 159                 } elsif ($opts{$sopt}) {
 160                         ++${$opts{$sopt}} if ref($opts{$sopt}) eq "SCALAR";
 161                         &{$opts{$sopt}}() if ref($opts{$sopt}) eq "CODE";
 162                 } elsif ($opts{":$sopt"}) {
 163                         &$failsub(':', $opt),return(0) unless @ARGV;
 164                         my $val = shift @ARGV;
 165                         ${$opts{":$sopt"}} = $val if ref($opts{":$sopt"} eq "SCALAR");
 166                         &{$opts{":$sopt"}}($val) if ref($opts{":$sopt"} eq "CODE");
 167                 } else {
 168                         &$failsub('?', $opt);
 169                         return 0;
 170                 }
 171         }
 172         if (@ARGV && $ARGV[0] eq "--") {
 173                 shift @ARGV;
 174                 return 1;
 175         }
 176         if (@ARGV && $ARGV[0] =~ /^-./) {
 177                 &$failsub('?', $ARGV[0]);
 178                 return 0;
 179         }
 180         return 1;
 181 }
 182
 183 sub recreate_file {
 184         open F, '>', $_[0] or die "failed to create $_[0]: $!\n";
 185         close F;
 186 }
 187
 188 sub is_yes {
 189         my $b = shift;
 190         my $strict = shift;
 191         defined ($b) or $b = "";
 192         return lc($b) eq "yes" || (!$strict && lc($b) eq "y");
 193 }
 194
 195 sub is_no {
 196         my $b = shift;
 197         my $strict = shift;
 198         defined ($b) or $b = "";
 199         return lc($b) eq "no" || (!$strict && lc($b) eq "n");
 200 }
 201
 202 sub is_yesno {
 203         return is_yes(@_) || is_no(@_);
 204 }
 205
 206 my %boolvals;
 207 BEGIN {
 208         %boolvals = (
 209                 true  => 1,
 210                 on    => 1,
 211                 yes   => 1,
 212                 y     => 1,
 213                 1     => 1,
 214
 215                 false => 0,
 216                 off   => 0,
 217                 no    => 0,
 218                 n     => 0,
 219                 0     => 0,
 220         );
 221 }
 222
 223 sub valid_bool {
 224         exists($boolvals{lc($_[0])});
 225 }
 226
 227 sub clean_bool {
 228         my $b = shift || 0;
 229         return $boolvals{lc($b)} || 0;
 230 }
 231
 232 sub _prompt_rl {
 233         my ($norl, $prompt, $default, $promptsfx) = @_;
 234         ! -t STDIN and $norl = 1;
 235         defined($promptsfx) or $promptsfx = ': ';
 236         defined($prompt) or $prompt = '';
 237         my $ds = '';
 238         $ds = " [" . $default . "]" if defined($default);
 239         if ($have_rl && !$norl) {
 240                 my $rl = Term::ReadLine->new(basename($0), \*STDIN, \*STDOUT);
 241                 $rl->ornaments(0);
 242                 $_ = $rl->readline($prompt . $ds . $promptsfx);
 243                 $rl->addhistory($_) if defined($_) && $_ =~ /\S/;
 244         } else {
 245                 print $prompt, $ds, $promptsfx;
 246                 $_ = <STDIN>;
 247         }
 248         return undef unless defined($_);
 249         chomp;
 250         return $_ eq '' && defined($default) ? $default : $_;
 251 }
 252
 253 sub prompt {
 254         return _prompt_rl(undef, @_);
 255 }
 256
 257 sub ynprompt {
 258         my $result;
 259         my @args = @_;
 260         $args[2] = "? " unless defined$args[2];
 261         {
 262                 $result = prompt(@args);
 263                 return undef unless defined($result);
 264                 redo unless is_yesno($result);
 265         }
 266         return clean_bool($result);
 267 }
 268
 269 sub _prompt_rl_or_die {
 270         my $result = _prompt_rl(@_);
 271         unless (defined($result)) {
 272                 my $nm = $diename;
 273                 defined($nm) or $nm = "";
 274                 $nm eq "" or $nm .= " ";
 275                 die "\n${nm}aborted\n";
 276         }
 277         $result;
 278 }
 279
 280 sub prompt_or_die {
 281         return _prompt_rl_or_die(undef, @_);
 282 }
 283
 284 sub ynprompt_or_die {
 285         my $result = ynprompt(@_);
 286         unless (defined($result)) {
 287                 my $nm = $diename;
 288                 defined($nm) or $nm = "";
 289                 $nm eq "" or $nm .= " ";
 290                 die "\n${nm}aborted\n";
 291         }
 292         $result;
 293 }
 294
 295 sub prompt_noecho {
 296         my $ne = Girocco::CLIUtil::NoEcho->new;
 297         _prompt_rl(1, @_);
 298 }
 299
 300 sub prompt_noecho_or_die {
 301         my $ne = Girocco::CLIUtil::NoEcho->new;
 302         _prompt_rl_or_die(1, @_);
 303 }
 304
 305 sub prompt_noecho_nl {
 306         my $result = prompt_noecho(@_);
 307         print "\n";
 308         $result;
 309 }
 310
 311 sub prompt_noecho_nl_or_die {
 312         my $result = prompt_noecho_or_die(@_);
 313         print "\n";
 314         $result;
 315 }
 316
 317 sub yes_to_continue {
 318         return !!ynprompt(($_[0]||"Continue (enter \"yes\" to continue)"), "no");
 319 }
 320
 321 sub yes_to_continue_or_die {
 322         unless (ynprompt_or_die(($_[0]||"Continue (enter \"yes\" to continue)"), "no")) {
 323                 my $nm = $diename;
 324                 defined($nm) or $nm = "";
 325                 $nm .= " " if $nm ne "";
 326                 die "${nm}aborted\n";
 327         }
 328         return 1;
 329 }
 330
 331 my @user_list;
 332 my $user_list_loaded;
 333 my @full_user_list;
 334 my $full_user_list_loaded;
 335
 336 # If single argument is true, return ALL passwd entries not just "...@..." ones
 337 sub _get_all_users_internal {
 338         my $full = shift || 0;
 339         if ($full) {
 340                 return @full_user_list if $full_user_list_loaded;
 341         } else {
 342                 return @user_list if $user_list_loaded;
 343         }
 344         my $passwd_file = jailed_file("/etc/passwd");
 345         open my $fd, '<', $passwd_file or die "could not open \"$passwd_file\": $!\n";
 346         my $line = 0;
 347         my @users;
 348         if ($full) {
 349                 @users = map {/^([^:\s#][^:\s]*):[^:]*:(-?\d+):(-?\d+)(:|$)/
 350                          ? [++$line,split(':',$_,-1)] : ()} <$fd>;
 351         } else {
 352                 @users = map {/^([^:_\s#][^:\s#]*):[^:]+:(\d{5,}):(\d+):([^:,][^:]*)/
 353                          ? [++$line,$1,$2,$3,split(',',$4)] : ()} <$fd>;
 354         }
 355         close $fd;
 356         if ($full) {
 357                 $$_[5] = [split(',', $$_[5])] foreach @users;
 358                 @full_user_list = @users;
 359                 $full_user_list_loaded = 1;
 360         } else {
 361                 @users = grep({$$_[4] =~ /\@/} @users);
 362                 @user_list = @users;
 363                 $user_list_loaded = 1;
 364         }
 365         @users;
 366 }
 367
 368 # Return array of arrayref where each arrayref has:
 369 #   [0] = ordering ordinal from $chroot/etc/passwd
 370 #   [1] = user name
 371 #   [2] = user id number
 372 #   [3] = user group number
 373 #   [4] = user email
 374 #   [5] = user UUID (text as 8x-4x-4x-4x-12x) or undef if none
 375 #   [6] = user creation date as YYYYMMDD_HHMMSS (UTC) or undef if none
 376 sub get_all_users { return _get_all_users_internal; }
 377
 378 # Return array of arrayref where each arrayref has:
 379 #   [0] = ordering ordinal from $chroot/etc/passwd
 380 #   [1] = user name
 381 #   [2] = user password field (usually "x")
 382 #   [3] = user id number
 383 #   [4] = user group number
 384 #   [5] = [info fields] from passwd line (usually email,uuid,creation)
 385 #   [6] = home dir field
 386 #   [7] = shell field
 387 #   [...] possibly more, but [7] is usually max
 388 sub get_full_users { return _get_all_users_internal(1); }
 389
 390 # Result of Girocco::User->load or fatal die if that fails
 391 # Returns undef if passed undef or ""
 392 sub get_user {
 393         my $username = shift;
 394         defined($username) && $username ne "" or return undef;
 395         Girocco::User::does_exist($username, 1) or die "No such user: \"$username\"\n";
 396         my $user;
 397         eval {
 398                 $user = Girocco::User->load($username);
 399                 1;
 400         } && $user->{uid} or die "Could not load user \"$username\"\n";
 401         $user;
 402 }
 403
 404 my @project_list;
 405 my $project_list_loaded;
 406
 407 # Return array of arrayref where each arrayref has:
 408 #   [0] = ordering ordinal from $chroot/etc/group
 409 #   [1] = group name
 410 #   [2] = group password hash
 411 #   [3] = group id number
 412 #   [4] = owner from gitproj.list
 413 #   [5] = list of comma-separated push user names (can be "") or ":" if mirror
 414 sub get_all_projects {
 415         return @project_list if $project_list_loaded;
 416         my $fd;
 417         my $projlist_file = $Girocco::Config::projlist_cache_dir."/gitproj.list";
 418         open $fd, '<', $projlist_file or die "could not open \"$projlist_file\": $!\n";
 419         my $chomper = sub {chomp(my $x = shift); $x;};
 420         my %owners = map {(split(/\s+/, &$chomper($_), 3))[0,2]} <$fd>;
 421         close $fd;
 422         my $group_file = jailed_file("/etc/group");
 423         open $fd, '<', $group_file or die "could not open \"$group_file\": $!\n";
 424         my $line = 0;
 425         my $trimu = sub {
 426                 my $list = shift;
 427                 return ':' if $list =~ /^:/;
 428                 $list =~ s/:.*$//;
 429                 $list;
 430         };
 431         my $defu = sub {defined($_[0])?$_[0]:""};
 432         my @projects = map {/^([^:_\s#][^:\s#]*):([^:]*):(\d{5,}):(.*)$/
 433                             ? [++$line,$1,$2,$3,&$defu($owners{$1}),&$trimu($4)] : ()} <$fd>;
 434         close $fd;
 435         @project_list = @projects;
 436         $project_list_loaded = 1;
 437         @project_list;
 438 }
 439
 440 # Result of Girocco::Project->load or fatal die if that fails
 441 # Returns undef if passed undef or ""
 442 sub get_project {
 443         my $projname = shift;
 444         $projname =~ s/\.git$//i if defined($projname);
 445         defined($projname) && $projname ne "" or return undef;
 446         Girocco::Project::does_exist($projname, 1) or die "No such project: \"$projname\"\n";
 447         my $project;
 448         eval {
 449                 $project = Girocco::Project->load($projname);
 450                 1;
 451         } && $project->{loaded} or die "Could not load project \"$projname\"\n";
 452         $project;
 453 }
 454
 455 # return true if $enc_passwd is a match for $plain_passwd
 456 sub check_passwd_match {
 457         my ($enc_passwd, $plain_passwd) = @_;
 458         defined($enc_passwd) or $enc_passwd = '';
 459         defined($plain_passwd) or $plain_passwd = '';
 460         # $enc_passwd may be crypt or crypt_sha1
 461         if ($enc_passwd =~ m(^\$sha1\$(\d+)\$([./0-9A-Za-z]{1,64})\$[./0-9A-Za-z]{28}$)) {
 462                 # It's using sha1-crypt
 463                 return $enc_passwd eq crypt_sha1($plain_passwd, $2, -(0+$1));
 464         } else {
 465                 # It's using crypt
 466                 return $enc_passwd eq crypt($plain_passwd, $enc_passwd);
 467         }
 468 };
 469
 470 sub _which {
 471         my $cmd = shift;
 472         foreach (File::Spec->path()) {
 473                 my $p = File::Spec->catfile($_, $cmd);
 474                 no warnings 'newline';
 475                 return $p if -x $p && -f _;
 476         }
 477         return undef;
 478 }
 479
 480 # apply maximum nice and ionice
 481 my $ionice;
 482 sub nice_me {
 483         my $niceval = shift;
 484         if (defined($niceval) && $niceval =~ /^\d+$/ && 0 + $niceval >= 1) {
 485                 my $oldval = POSIX::nice(0);
 486                 POSIX::nice($niceval - $oldval) if $oldval && $niceval > $oldval;
 487         } else {
 488                 POSIX::nice(20);
 489         }
 490         defined($ionice) or $ionice = _which("ionice");
 491         defined($ionice) or $ionice = "";
 492         if ($ionice ne "") {
 493                 my $devnullfd = POSIX::open(File::Spec->devnull, O_RDWR);
 494                 defined($devnullfd) && $devnullfd >= 0 or die "cannot open /dev/null: $!";
 495                 my ($dupin, $dupout, $duperr);
 496                 open $dupin, '<&0' or die "cannot dup STDIN_FILENO: $!";
 497                 open $dupout, '>&1' or die "cannot dup STDOUT_FILENO: $!";
 498                 open $duperr, '>&2' or die "cannot dup STDERR_FILENO: $!";
 499                 POSIX::dup2($devnullfd, 0) or die "cannot dup2 STDIN_FILENO: $!";
 500                 POSIX::dup2($devnullfd, 1) or die "cannot dup2 STDOUT_FILENO: $!";
 501                 POSIX::dup2($devnullfd, 2) or POSIX::dup2(fileno($duperr), 2), die "cannot dup2 STDERR_FILENO: $!";
 502                 POSIX::close($devnullfd);
 503                 system $ionice, "-c", "3", "-p", $$;
 504                 POSIX::dup2(fileno($duperr), 2) or die "cannot dup2 STDERR_FILENO: $!";
 505                 POSIX::dup2(fileno($dupout), 1) or die "cannot dup2 STDOUT_FILENO: $!";
 506                 POSIX::dup2(fileno($dupin), 0) or die "cannot dup2 STDIN_FILENO: $!";
 507                 close $duperr;
 508                 close $dupout;
 509                 close $dupin;
 510         }
 511 }
 512
 513 # spawn a pager and return the write side of
 514 # a pipe to its input.  Does not check to see
 515 # if STDOUT is a terminal or anything else like
 516 # that.  Caller is responsible for those checks.
 517 # Pager will be chosen as follows:
 518 #   1. $ENV{PAGER} if non-empty (eval'd by shell)
 519 #   2. less if found in $ENV{PATH}
 520 #   3. more if found in $ENV{PATH}
 521 # Returns undef if no pager can be found or
 522 # setup fails.  If return context is wantarray
 523 # and pager is created, will return list of
 524 # new output handle and pid of child.
 525 # As a special case to facilitate paging of STDOUT,
 526 # if the first argument is the string "become child",
 527 # then, if a pager is created, the child will return
 528 # to the caller and the parent will exec the pager!
 529 # (The returned pid in that case is the parent's pid.)
 530 sub setup_pager {
 531         my $magic = $_[0];
 532         defined($magic) && lc($magic) eq "become child" or
 533                 $magic = 0;
 534         my @cmd = ();
 535         if (defined($ENV{PAGER}) && $ENV{PAGER} ne "") {
 536                 my $cmd = $ENV{PAGER};
 537                 $cmd =~ /^(.+)$/ and $cmd = $1;
 538                 my $pgbin = undef;
 539                 {
 540                         no warnings 'newline';
 541                         -x $cmd && -f $cmd and $pgbin = $cmd;
 542                 }
 543                 defined($pgbin) && $pgbin ne "" or $pgbin = _which($cmd);
 544                 if (defined($pgbin) && $pgbin ne "") {
 545                         $pgbin =~ /^(.+)$/ and push(@cmd, $1);
 546                 } else {
 547                         $cmd =~ /\s/ || is_shellish($cmd) or
 548                                 return undef;
 549                         my $sh = $Girocco::Config::posix_sh_bin;
 550                         defined($sh) && $sh ne "" or $sh = '/bin/sh';
 551                         push(@cmd, $sh, "-c", $cmd, $sh);
 552                 }
 553         }
 554         if (!@cmd) {
 555                 my $pgbin = _which("less");
 556                 $pgbin or $pgbin = _which("more");
 557                 defined($pgbin) && $pgbin ne "" or return undef;
 558                 $pgbin =~ /^(.+)$/ and push(@cmd, $1);
 559         }
 560         local $ENV{LESS} = "-FRX" unless exists($ENV{LESS});
 561         local $ENV{LV} = "-c" unless exists($ENV{LV});
 562         my $pghnd;
 563         use POSIX ();
 564         my ($rfd, $wfd) = POSIX::pipe();
 565         defined($rfd) && defined($wfd) && $rfd >= 0 && $wfd >= 0 or
 566                 die "POSIX::pipe failed: $!\n";
 567         my $pid = fork();
 568         defined($pid) or
 569                 die "fork failed: $!\n";
 570         if (!$magic && !$pid || $magic && $pid) {
 571                 POSIX::close($wfd);
 572                 POSIX::dup2($rfd, 0);
 573                 POSIX::close($rfd);
 574                 $magic and $SIG{CHLD} = 'IGNORE';
 575                 exec {$cmd[0]} @cmd or
 576                         die "exec \"$cmd[0]\" failed: $!\n";
 577         }
 578         $magic and $pid = getppid();
 579         POSIX::close($rfd);
 580         open $pghnd, '>&=', $wfd or
 581                         die "fdopen of pipe write end failed: $!\n";
 582         defined($pid) && defined($pghnd) or return undef;
 583         return wantarray ? ($pghnd, $pid) : $pghnd;
 584 }
 585
 586 # return true if any of the known PAGER_IN_USE environment
 587 # variables are set
 588 sub pager_in_use {
 589         return $ENV{GIT_PAGER_IN_USE} || $ENV{TG_PAGER_IN_USE};
 590 }
 591
 592 # possibly set STDOUT to flow through a pager
 593 # $_[0]:
 594 #   defined and false  -> return without doing anything
 595 #   defined and true   -> set STDOUT to setup_pager result
 596 #   undefined:
 597 #     ! -t STDOUT      -> return without doing anything
 598 #     -t STDOUT:
 599 #       $_[1] is false -> set STDOUT to setup_pager result
 600 #       $_[1] is true  -> return without doing anything
 601 # $[1] means do NOT enable paging by default on -t STDOUT
 602 # Most clients can simply call this function without arguments
 603 # which will add a pager only if STDOUT is a terminal
 604 # If pager_in_use, returns without doing anything.
 605 # If pager is activated, sets known pager in use env vars.
 606 sub setup_pager_stdout {
 607         pager_in_use() and return;
 608         my $want_pager = $_[0];
 609         defined($want_pager) or
 610                 $want_pager = (-t STDOUT) ? !$_[1] : 0;
 611         return unless $want_pager;
 612         my $pghnd = setup_pager('become child');
 613         defined($pghnd) or return;
 614         if (open(STDOUT, '>&=', $pghnd)) {
 615                 $ENV{GIT_PAGER_IN_USE} = 1;
 616                 $ENV{TG_PAGER_IN_USE} = 1;
 617         } else {
 618                 die "failed to set STDOUT to pager: $!\n";
 619         }
 620 }
 621
 622 1;