setup/setup-openssh.pl

   1 #!/usr/bin/perl
   2 #
   3 # setup-openssh.pl
   4 #
   5 # Adapts the installed gsi-openssh environment to the current machine,
   6 # performing actions that originally occurred during the package's
   7 # 'make install' phase.
   8 #
   9 # Send comments/fixes/suggestions to:
  10 # Chase Phillips <cphillip@ncsa.uiuc.edu>
  11 #
  12
  13 #
  14 # Get user's GPT_LOCATION since we may be installing this using a new(er)
  15 # version of GPT.
  16 #
  17
  18 $gptpath = $ENV{GPT_LOCATION};
  19
  20 #
  21 # And the old standby..
  22 #
  23
  24 $gpath = $ENV{GLOBUS_LOCATION};
  25 if (!defined($gpath))
  26 {
  27     exitDie("ERROR: GLOBUS_LOCATION needs to be set before running this script!\n");
  28 }
  29
  30 #
  31 # Include standard modules
  32 #
  33
  34 use Getopt::Long;
  35 use Cwd;
  36 use Cwd 'abs_path';
  37
  38 #
  39 # modify the ld library path for when we call ssh executables
  40 #
  41
  42 $oldldpath = $ENV{LD_LIBRARY_PATH};
  43 $newldpath = "$gpath/lib";
  44 if (length($oldldpath) > 0)
  45 {
  46     $newldpath .= ":$oldldpath";
  47 }
  48 $ENV{LD_LIBRARY_PATH} = "$newldpath";
  49
  50 #
  51 # i'm including this because other perl scripts in the gpt setup directories
  52 # do so
  53 #
  54
  55 if (defined($gptpath))
  56 {
  57     @INC = (@INC, "$gptpath/lib/perl", "$gpath/lib/perl");
  58 }
  59 else
  60 {
  61     @INC = (@INC, "$gpath/lib/perl");
  62 }
  63
  64 require Grid::GPT::Setup;
  65
  66 #
  67 # script-centred variable initialization
  68 #
  69
  70 my $globusdir = $gpath;
  71 my $myname = "setup-openssh.pl";
  72
  73 #
  74 # Set up path prefixes for use in the path translations
  75 #
  76
  77 $prefix = ${globusdir};
  78 $exec_prefix = "${prefix}";
  79 $bindir = "${exec_prefix}/bin";
  80 $sbindir = "${exec_prefix}/sbin";
  81 $sysconfdir = "$prefix/etc/ssh";
  82 $localsshdir = "/etc/ssh";
  83 $setupdir = "$prefix/setup/gsi_openssh_setup";
  84
  85 #
  86 # standard key types and their root file name mappings
  87 #
  88
  89 my $keyfiles = {
  90                  "dsa" => "ssh_host_dsa_key",
  91                  "rsa" => "ssh_host_rsa_key",
  92                  "rsa1" => "ssh_host_key",
  93                };
  94
  95 #
  96 # argument specification.  we offload some processing work from later functions
  97 # to verify correct args by using anon subs in various places.
  98 #
  99
 100 my($prompt, $force, $verbose);
 101
 102 $prompt = 1;
 103 $verbose = 0;
 104
 105 GetOptions(
 106             'prompt!' => \$prompt,
 107             'force' => \$force,
 108             'verbose' => \$verbose,
 109           ) or pod2usage(2);
 110
 111 #
 112 # miscellaneous initialization functions
 113 #
 114
 115 setPrivilegeSeparation(0);
 116
 117 #
 118 # main execution.  This should find its way into a subroutine at some future
 119 # point.
 120 #
 121
 122 debug0("Configuring gsi_openssh\n");
 123 debug0("------------------------------------------------------------\n");
 124 debug0("Executing...\n");
 125
 126 makeConfDir();
 127 copyPRNGFile();
 128 $keyhash = determineKeys();
 129 runKeyGen($keyhash->{gen});
 130 copyKeyFiles($keyhash->{copy});
 131 copyConfigFiles();
 132
 133 my $metadata = new Grid::GPT::Setup(package_name => "gsi_openssh_setup");
 134
 135 $metadata->finish();
 136
 137 debug0("\n");
 138 debug0("Notes:\n\n");
 139
 140 if ( getPrivilegeSeparation() )
 141 {
 142     debug0("  o Privilege separation is on.\n");
 143 }
 144 elsif ( !getPrivilegeSeparation() )
 145 {
 146     debug0("  o Privilege separation is off.\n");
 147 }
 148
 149 debug0("  o GSI-OpenSSH website is <http://grid.ncsa.uiuc.edu/ssh/>.\n");
 150 debug0("------------------------------------------------------------\n");
 151 debug0("Finished configuring gsi_openssh.\n");
 152
 153 exit;
 154
 155 #
 156 # subroutines
 157 #
 158
 159 ### initPRNGHash( )
 160 #
 161 # initialize the PRNG pathname hash
 162 #
 163
 164 sub initPRNGHash( )
 165 {
 166     #
 167     # standard prng to executable conversion names
 168     #
 169
 170     addPRNGCommand("\@PROG_LS\@", "ls");
 171     addPRNGCommand("\@PROG_NETSTAT\@", "netstat");
 172     addPRNGCommand("\@PROG_ARP\@", "arp");
 173     addPRNGCommand("\@PROG_IFCONFIG\@", "ifconfig");
 174     addPRNGCommand("\@PROG_PS\@", "ps");
 175     addPRNGCommand("\@PROG_JSTAT\@", "jstat");
 176     addPRNGCommand("\@PROG_W\@", "w");
 177     addPRNGCommand("\@PROG_WHO\@", "who");
 178     addPRNGCommand("\@PROG_LAST\@", "last");
 179     addPRNGCommand("\@PROG_LASTLOG\@", "lastlog");
 180     addPRNGCommand("\@PROG_DF\@", "df");
 181     addPRNGCommand("\@PROG_SAR\@", "sar");
 182     addPRNGCommand("\@PROG_VMSTAT\@", "vmstat");
 183     addPRNGCommand("\@PROG_UPTIME\@", "uptime");
 184     addPRNGCommand("\@PROG_IPCS\@", "ipcs");
 185     addPRNGCommand("\@PROG_TAIL\@", "tail");
 186
 187     debug1("Determining paths for PRNG commands...\n");
 188
 189     $paths = determinePRNGPaths();
 190
 191     return;
 192 }
 193
 194 ### getDirectoryPaths( )
 195 #
 196 # return an array ref containing all of the directories in which we should search
 197 # for our listing of executable names.
 198 #
 199
 200 sub getDirectoryPaths( )
 201 {
 202     #
 203     # read in the PATH environmental variable and prepend a set of 'safe'
 204     # directories from which to test PRNG commands.
 205     #
 206
 207     $path = $ENV{PATH};
 208     $path = "/bin:/usr/bin:/sbin:/usr/sbin:/etc:" . $path;
 209     @dirs = split(/:/, $path);
 210
 211     #
 212     # sanitize each directory listed in the array.
 213     #
 214
 215     @dirs = map {
 216                   $tmp = $_;
 217                   $tmp =~ s:/+:/:g;
 218                   $tmp =~ s:^\s+|\s+$::g;
 219                   $tmp;
 220                 } @dirs;
 221
 222     return \@dirs;
 223 }
 224
 225 ### addPRNGCommand( $prng_name, $exec_name )
 226 #
 227 # given a PRNG name and a corresponding executable name, add it to our list of
 228 # PRNG commands for which to find on the system.
 229 #
 230
 231 sub addPRNGCommand
 232 {
 233     my($prng_name, $exec_name) = @_;
 234
 235     prngAddNode($prng_name, $exec_name);
 236 }
 237
 238 ### copyPRNGFile( )
 239 #
 240 # read in ssh_prng_cmds.in, translate the program listings to the paths we have
 241 # found on the local system, and then write the output to ssh_prng_cmds.
 242 #
 243
 244 sub copyPRNGFile
 245 {
 246     my($fileInput, $fileOutput);
 247     my($mode, $uid, $gid);
 248     my($data);
 249
 250     if ( isPresent("$sysconfdir/ssh_prng_cmds") && !isForced() )
 251     {
 252         debug1("ssh_prng_cmds found and not forced.  Not installing ssh_prng_cmds...\n");
 253         return;
 254     }
 255
 256     initPRNGHash();
 257
 258     debug1("Fixing paths in ssh_prng_cmds...\n");
 259
 260     $fileInput = "$setupdir/ssh_prng_cmds.in";
 261     $fileOutput = "$sysconfdir/ssh_prng_cmds";
 262
 263     #
 264     # verify that we are prepared to work with $fileInput
 265     #
 266
 267     if ( !isReadable($fileInput) )
 268     {
 269         debug1("Cannot read $fileInput... skipping.\n");
 270         return;
 271     }
 272
 273     #
 274     # verify that we are prepared to work with $fileOuput
 275     #
 276
 277     if ( !prepareFileWrite($fileOutput) )
 278     {
 279         return;
 280     }
 281
 282     #
 283     # Grab the current mode/uid/gid for use later
 284     #
 285
 286     $mode = (stat($fileInput))[2];
 287     $uid = (stat($fileInput))[4];
 288     $gid = (stat($fileInput))[5];
 289
 290     #
 291     # Open the files for reading and writing, and loop over the input's contents
 292     #
 293
 294     $data = readFile($fileInput);
 295     for my $k (keys %$prngcmds)
 296     {
 297         $sub = prngGetExecPath($k);
 298         $data =~ s:$k:$sub:g;
 299     }
 300     writeFile($fileOutput, $data);
 301
 302     #
 303     # An attempt to revert the new file back to the original file's
 304     # mode/uid/gid
 305     #
 306
 307     chmod($mode, $fileOutput);
 308     chown($uid, $gid, $fileOutput);
 309
 310     return 0;
 311 }
 312
 313 ### determinePRNGPaths( )
 314 #
 315 # for every entry in the PRNG hash, seek out and find the path for the
 316 # corresponding executable name.
 317 #
 318
 319 sub determinePRNGPaths
 320 {
 321     my(@paths, @dirs);
 322     my($exec_name, $exec_path);
 323
 324     $dirs = getDirectoryPaths();
 325
 326     for my $k (keys %$prngcmds)
 327     {
 328         $exec_name = prngGetExecName($k);
 329         $exec_path = findExecutable($exec_name, $dirs);
 330         prngSetExecPath($k, $exec_path);
 331     }
 332
 333     return;
 334 }
 335
 336 ### prngAddNode( $prng_name, $exec_name )
 337 #
 338 # add a new node to the PRNG hash
 339 #
 340
 341 sub prngAddNode
 342 {
 343     my($prng_name, $exec_name) = @_;
 344     my($node);
 345
 346     if (!defined($prngcmds))
 347     {
 348         $prngcmds = {};
 349     }
 350
 351     $node = {};
 352     $node->{prng} = $prng_name;
 353     $node->{exec} = $exec_name;
 354
 355     $prngcmds->{$prng_name} = $node;
 356 }
 357
 358 ### prngGetExecName( $key )
 359 #
 360 # get the executable name from the prng commands hash named by $key
 361 #
 362
 363 sub prngGetExecName
 364 {
 365     my($key) = @_;
 366
 367     return $prngcmds->{$key}->{exec};
 368 }
 369
 370 ### prngGetExecPath( $key )
 371 #
 372 # get the executable path from the prng commands hash named by $key
 373 #
 374
 375 sub prngGetExecPath
 376 {
 377     my($key) = @_;
 378
 379     return $prngcmds->{$key}->{exec_path};
 380 }
 381
 382 ### prngGetNode( $key )
 383 #
 384 # return a reference to the node named by $key
 385 #
 386
 387 sub prngGetNode
 388 {
 389     my($key) = @_;
 390
 391     return ${$prngcmds}{$key};
 392 }
 393
 394 ### prngSetExecPath( $key, $path )
 395 #
 396 # given a key, set the executable path in that node to $path
 397 #
 398
 399 sub prngSetExecPath
 400 {
 401     my($key, $path) = @_;
 402
 403     $prngcmds->{$key}->{exec_path} = $path;
 404 }
 405
 406 ### findExecutable( $exec_name, $dirs )
 407 #
 408 # given an executable name, test each possible path in $dirs to see if such
 409 # an executable exists.
 410 #
 411
 412 sub findExecutable
 413 {
 414     my($exec_name, $dirs) = @_;
 415
 416     for my $d (@$dirs)
 417     {
 418         $test = "$d/$exec_name";
 419
 420         if ( isExecutable($test) )
 421         {
 422             return $test;
 423         }
 424     }
 425
 426     return "undef";
 427 }
 428
 429 ### copyKeyFiles( $copylist )
 430 #
 431 # given an array of keys to copy, copy both the key and its public variant into
 432 # the gsi-openssh configuration directory.
 433 #
 434
 435 sub copyKeyFiles
 436 {
 437     my($copylist) = @_;
 438     my($regex, $basename);
 439
 440     if (@$copylist)
 441     {
 442         debug1("Copying ssh host keys...\n");
 443
 444         for my $f (@$copylist)
 445         {
 446             $f =~ s:/+:/:g;
 447
 448             if (length($f) > 0)
 449             {
 450                 $keyfile = "$f";
 451                 $pubkeyfile = "$f.pub";
 452
 453                 copyFile("$localsshdir/$keyfile", "$sysconfdir/$keyfile");
 454                 copyFile("$localsshdir/$pubkeyfile", "$sysconfdir/$pubkeyfile");
 455             }
 456         }
 457     }
 458 }
 459
 460 ### isForced( )
 461 #
 462 # return true if the user passed in the force flag.  return false otherwise.
 463 #
 464
 465 sub isForced
 466 {
 467     if ( defined($force) && $force )
 468     {
 469         return 1;
 470     }
 471     else
 472     {
 473         return 0;
 474     }
 475 }
 476
 477 ### isReadable( $file )
 478 #
 479 # given a file, return true if that file both exists and is readable by the
 480 # effective user id.  return false otherwise.
 481 #
 482
 483 sub isReadable
 484 {
 485     my($file) = @_;
 486
 487     if ( ( -e $file ) && ( -r $file ) )
 488     {
 489         return 1;
 490     }
 491     else
 492     {
 493         return 0;
 494     }
 495 }
 496
 497 ### isExecutable( $file )
 498 #
 499 # return true if $file is executable.  return false otherwise.
 500 #
 501
 502 sub isExecutable
 503 {
 504     my($file) = @_;
 505
 506     if ( -x $file )
 507     {
 508         return 1;
 509     }
 510     else
 511     {
 512         return 0;
 513     }
 514 }
 515
 516 ### isWritable( $file )
 517 #
 518 # given a file, return true if that file does not exist or is writable by the
 519 # effective user id.  return false otherwise.
 520 #
 521
 522 sub isWritable
 523 {
 524     my($file) = @_;
 525
 526     if ( ( ! -e $file ) || ( -w $file ) )
 527     {
 528         return 1;
 529     }
 530     else
 531     {
 532         return 0;
 533     }
 534 }
 535
 536 ### isPresent( $file )
 537 #
 538 # given a file, return true if that file exists.  return false otherwise.
 539 #
 540
 541 sub isPresent
 542 {
 543     my($file) = @_;
 544
 545     if ( -e $file )
 546     {
 547         return 1;
 548     }
 549     else
 550     {
 551         return 0;
 552     }
 553 }
 554
 555 ### makeConfDir( )
 556 #
 557 # make the gsi-openssh configuration directory if it doesn't already exist.
 558 #
 559
 560 sub makeConfDir
 561 {
 562     if ( isPresent($sysconfdir) )
 563     {
 564         if ( -d $sysconfdir )
 565         {
 566             return;
 567         }
 568
 569         debug1("${sysconfdir} already exists and is not a directory!\n");
 570         exit;
 571     }
 572
 573     debug1("Could not find ${sysconfdir} directory... creating.\n");
 574     action("mkdir -p $sysconfdir");
 575
 576     return;
 577 }
 578
 579 ### determineKeys( )
 580 #
 581 # based on a set of key types, triage them to determine if for each key type, that
 582 # key type should be copied from the main ssh configuration directory, or if it
 583 # should be generated using ssh-keygen.
 584 #
 585
 586 sub determineKeys
 587 {
 588     my($keyhash, $keylist);
 589     my($count);
 590
 591     #
 592     # initialize our variables
 593     #
 594
 595     $count = 0;
 596
 597     $keyhash = {};
 598     $keyhash->{gen} = [];   # a list of keytypes to generate
 599     $keyhash->{copy} = [];  # a list of files to copy from the
 600
 601     $genlist = $keyhash->{gen};
 602     $copylist = $keyhash->{copy};
 603
 604     #
 605     # loop over our keytypes and determine what we need to do for each of them
 606     #
 607
 608     for my $keytype (keys %$keyfiles)
 609     {
 610         $basekeyfile = $keyfiles->{$keytype};
 611
 612         #
 613         # if the key's are already present, we don't need to bother with this rigamarole
 614         #
 615
 616         $gkeyfile = "$sysconfdir/$basekeyfile";
 617         $gpubkeyfile = "$sysconfdir/$basekeyfile.pub";
 618
 619         if ( isPresent($gkeyfile) && isPresent($gpubkeyfile) )
 620         {
 621             if ( isForced() )
 622             {
 623                 if ( isWritable("$sysconfdir/$basekeyfile") && isWritable("$sysconfdir/$basekeyfile.pub") )
 624                 {
 625                      action("rm $sysconfdir/$basekeyfile");
 626                      action("rm $sysconfdir/$basekeyfile.pub");
 627                 }
 628                 else
 629                 {
 630                      next;
 631                 }
 632             }
 633         }
 634
 635         #
 636         # if we can find a copy of the keys in /etc/ssh, we'll copy them to the user's
 637         # globus location
 638         #
 639
 640         $mainkeyfile = "$localsshdir/$basekeyfile";
 641         $mainpubkeyfile = "$localsshdir/$basekeyfile.pub";
 642
 643         if ( isReadable($mainkeyfile) && isReadable($mainpubkeyfile) )
 644         {
 645             push(@$copylist, $basekeyfile);
 646             $count++;
 647             next;
 648         }
 649
 650         #
 651         # otherwise, we need to generate the key
 652         #
 653
 654         push(@$genlist, $keytype);
 655         $count++;
 656     }
 657
 658     return $keyhash;
 659 }
 660
 661 ### runKeyGen( $gen_keys )
 662 #
 663 # given a set of key types, generate private and public keys for that key type and
 664 # place them in the gsi-openssh configuration directory.
 665 #
 666
 667 sub runKeyGen
 668 {
 669     my($gen_keys) = @_;
 670     my $keygen = "$bindir/ssh-keygen";
 671
 672     if (@$gen_keys && -x $keygen)
 673     {
 674         debug1("Generating ssh host keys...\n");
 675
 676         for my $k (@$gen_keys)
 677         {
 678             $keyfile = $keyfiles->{$k};
 679
 680             if ( !isPresent("$sysconfdir/$keyfile") )
 681             {
 682                 action("$bindir/ssh-keygen -t $k -f $sysconfdir/$keyfile -N \"\"");
 683             }
 684         }
 685     }
 686
 687     return 0;
 688 }
 689
 690 ### copySSHDConfigFile( )
 691 #
 692 # this subroutine 'edits' the paths in sshd_config to suit them to the current environment
 693 # in which the setup script is being run.
 694 #
 695
 696 sub copySSHDConfigFile
 697 {
 698     my($fileInput, $fileOutput);
 699     my($mode, $uid, $gid);
 700     my($line, $newline);
 701     my($privsep_enabled);
 702
 703     debug1("Fixing paths in sshd_config...\n");
 704
 705     $fileInput = "$setupdir/sshd_config.in";
 706     $fileOutput = "$sysconfdir/sshd_config";
 707
 708     #
 709     # verify that we are prepared to work with $fileInput
 710     #
 711
 712     if ( !isReadable($fileInput) )
 713     {
 714         debug1("Cannot read $fileInput... skipping.\n");
 715         return;
 716     }
 717
 718     #
 719     # verify that we are prepared to work with $fileOuput
 720     #
 721
 722     if ( !prepareFileWrite($fileOutput) )
 723     {
 724         return;
 725     }
 726
 727     #
 728     # check to see whether we should enable privilege separation
 729     #
 730
 731     if ( userExists("sshd") && ( -d "/var/empty" ) && ( getOwnerID("/var/empty") eq 0 ) )
 732     {
 733         setPrivilegeSeparation(1);
 734     }
 735     else
 736     {
 737         setPrivilegeSeparation(0);
 738     }
 739
 740     if ( getPrivilegeSeparation() )
 741     {
 742         $privsep_enabled = "yes";
 743     }
 744     else
 745     {
 746         $privsep_enabled = "no";
 747     }
 748
 749     #
 750     # Grab the current mode/uid/gid for use later
 751     #
 752
 753     $mode = (stat($fileInput))[2];
 754     $uid = (stat($fileInput))[4];
 755     $gid = (stat($fileInput))[5];
 756
 757     #
 758     # Open the files for reading and writing, and loop over the input's contents
 759     #
 760
 761     $data = readFile($fileInput);
 762
 763     # #
 764     # # alter the PidFile config
 765     # #
 766     #
 767     # $text = "PidFile\t$gpath/var/sshd.pid";
 768     # $data =~ s:^[\s|#]*PidFile.*$:$text:gm;
 769
 770     #
 771     # set the sftp directive
 772     #
 773
 774     $text = "Subsystem\tsftp\t$gpath/libexec/sftp-server";
 775     $data =~ s:^[\s|#]*Subsystem\s+sftp\s+.*$:$text:gm;
 776
 777     #
 778     # set the privilege separation directive
 779     #
 780
 781     $text = "UsePrivilegeSeparation\t${privsep_enabled}";
 782     $data =~ s:^[\s|#]*UsePrivilegeSeparation.*$:$text:gm;
 783
 784     #
 785     # dump the modified output to the config file
 786     #
 787
 788     writeFile($fileOutput, $data);
 789
 790     #
 791     # An attempt to revert the new file back to the original file's
 792     # mode/uid/gid
 793     #
 794
 795     chmod($mode, $fileOutput);
 796     chown($uid, $gid, $fileOutput);
 797
 798     return 0;
 799 }
 800
 801 ### setPrivilegeSeparation( $value )
 802 #
 803 # set the privilege separation variable to $value
 804 #
 805
 806 sub setPrivilegeSeparation
 807 {
 808     my($value) = @_;
 809
 810     $privsep = $value;
 811 }
 812
 813 ### getPrivilegeSeparation( )
 814 #
 815 # return the value of the privilege separation variable
 816 #
 817
 818 sub getPrivilegeSeparation
 819 {
 820     return $privsep;
 821 }
 822
 823 ### prepareFileWrite( $file )
 824 #
 825 # test $file to prepare for writing to it.
 826 #
 827
 828 sub prepareFileWrite
 829 {
 830     my($file) = @_;
 831
 832     if ( isPresent($file) )
 833     {
 834         debug1("$file already exists... ");
 835
 836         if ( isForced() )
 837         {
 838             if ( isWritable($file) )
 839             {
 840                 debug1("removing.\n");
 841                 action("rm $file");
 842                 return 1;
 843             }
 844             else
 845             {
 846                 debug1("not writable -- skipping.\n");
 847                 return 0;
 848             }
 849         }
 850         else
 851         {
 852             debug1("skipping.\n");
 853             return 0;
 854         }
 855     }
 856
 857     return 1;
 858 }
 859
 860 ### copyConfigFiles( )
 861 #
 862 # subroutine that copies some extra config files to their proper location in
 863 # $GLOBUS_LOCATION/etc/ssh.
 864 #
 865
 866 sub copyConfigFiles
 867 {
 868     #
 869     # copy the sshd_config file into the ssh configuration directory and alter
 870     # the paths in the file.
 871     #
 872
 873     copySSHDConfigFile();
 874
 875     #
 876     # do straight copies of the ssh_config and moduli files.
 877     #
 878
 879     debug1("Copying ssh_config and moduli to their proper location...\n");
 880
 881     copyFile("$setupdir/ssh_config", "$sysconfdir/ssh_config");
 882     copyFile("$setupdir/moduli", "$sysconfdir/moduli");
 883
 884     #
 885     # copy and alter the SXXsshd script.
 886     #
 887
 888     copySXXScript("$setupdir/SXXsshd.in", "$sbindir/SXXsshd");
 889 }
 890
 891 ### copyFile( $src, $dest )
 892 #
 893 # copy the file pointed to by $src to the location specified by $dest.  in the
 894 # process observe the rules regarding when the '-force' flag was passed to us.
 895 #
 896
 897 sub copyFile
 898 {
 899     my($src, $dest) = @_;
 900
 901     if ( !isReadable($src) )
 902     {
 903         debug1("$src is not readable... not creating $dest.\n");
 904         return;
 905     }
 906
 907     if ( !prepareFileWrite($dest) )
 908     {
 909         return;
 910     }
 911
 912     action("cp $src $dest");
 913 }
 914
 915 ### copySXXScript( $in, $out )
 916 #
 917 # parse the input file, substituting in place the value of GLOBUS_LOCATION, and
 918 # write the result to the output file.
 919 #
 920
 921 sub copySXXScript
 922 {
 923     my($in, $out) = @_;
 924     my($tmpgpath);
 925
 926     if ( !isReadable($in) )
 927     {
 928         debug1("$in is not readable... not creating $out.\n");
 929         return;
 930     }
 931
 932     if ( !prepareFileWrite($out) )
 933     {
 934         return;
 935     }
 936
 937     #
 938     # clean up any junk in the globus path variable
 939     #
 940
 941     $tmpgpath = $gpath;
 942     $tmpgpath =~ s:/+:/:g;
 943     $tmpgpath =~ s:([^/]+)/$:\1:g;
 944
 945     #
 946     # read in the script, substitute globus location, then write it back out
 947     #
 948
 949     $data = readFile($in);
 950     $data =~ s|\@GLOBUS_LOCATION\@|$tmpgpath|g;
 951     writeFile($out, $data);
 952     action("chmod 755 $out");
 953 }
 954
 955 ### readFile( $filename )
 956 #
 957 # reads and returns $filename's contents
 958 #
 959
 960 sub readFile
 961 {
 962     my($filename) = @_;
 963     my($data);
 964
 965     open(IN, "$filename") || exitDie("ERROR: Can't open '$filename': $!\n");
 966     $/ = undef;
 967     $data = <IN>;
 968     $/ = "\n";
 969     close(IN);
 970
 971     return $data;
 972 }
 973
 974 ### writeFile( $filename, $fileinput )
 975 #
 976 # create the inputs to the ssl program at $filename, appending the common name to the
 977 # stream in the process
 978 #
 979
 980 sub writeFile
 981 {
 982     my($filename, $fileinput) = @_;
 983
 984     #
 985     # test for a valid $filename
 986     #
 987
 988     if ( !defined($filename) || (length($filename) lt 1) )
 989     {
 990         exitDie("ERROR: Filename is undefined!\n");
 991     }
 992
 993     #
 994     # verify that we are prepared to work with $filename
 995     #
 996
 997     if ( !prepareFileWrite($filename) )
 998     {
 999         return;
1000     }
1001
1002     #
1003     # write the output to $filename
1004     #
1005
1006     open(OUT, ">$filename");
1007     print OUT "$fileinput";
1008     close(OUT);
1009 }
1010
1011 ### debug1( $arg1, $arg2 )
1012 #
1013 # Print out a debugging message at level 1.
1014 #
1015
1016 sub debug1
1017 {
1018     debug(string => \@_, level => 1);
1019 }
1020
1021 ### debug0( $arg1, $arg2 )
1022 #
1023 # Print out a debugging message at level 0.
1024 #
1025
1026 sub debug0
1027 {
1028     debug(string => \@_, level => 0);
1029 }
1030
1031 ### debug( string => $string, level => $level )
1032 #
1033 # Print out debugging messages at various levels.  Feel free to use debugN() directly
1034 # which in turn calls this subroutine.
1035 #
1036
1037 sub debug
1038 {
1039     my %args = @_;
1040
1041     if (!defined($args{'level'}))
1042     {
1043         $args{'level'} = 0;
1044     }
1045
1046     if ($verbose >= $args{'level'})
1047     {
1048         printf(@{$args{'string'}});
1049     }
1050 }
1051
1052 ### action( $command )
1053 #
1054 # run $command within a proper system() command.
1055 #
1056
1057 sub action
1058 {
1059     my($command) = @_;
1060
1061     debug1("$command\n");
1062
1063     my $result = system("LD_LIBRARY_PATH=\"$gpath/lib:\$LD_LIBRARY_PATH\"; $command >/dev/null 2>&1");
1064
1065     if (($result or $?) and $command !~ m!patch!)
1066     {
1067         exitDie("ERROR: Unable to execute command: $!\n");
1068     }
1069 }
1070
1071 ### exitDie( $error )
1072 #
1073 # a horribly named method meant to look like die but only exit, thereby not causing
1074 # gpt-postinstall to croak.
1075 #
1076
1077 sub exitDie
1078 {
1079     my($error) = @_;
1080
1081     print $error;
1082     exit;
1083 }
1084
1085 ### query_boolean( $query_text, $default )
1086 #
1087 # query the user with a string, and expect a response.  If the user hits
1088 # 'enter' instead of entering an input, then accept the default response.
1089 #
1090
1091 sub query_boolean
1092 {
1093     my($query_text, $default) = @_;
1094     my($nondefault, $foo, $bar);
1095
1096     if ( !$prompt )
1097     {
1098         print "Prompt suppressed.  Continuing...\n";
1099         return "y";
1100     }
1101
1102     #
1103     # Set $nondefault to the boolean opposite of $default.
1104     #
1105
1106     if ($default eq "n")
1107     {
1108         $nondefault = "y";
1109     }
1110     else
1111     {
1112         $nondefault = "n";
1113     }
1114
1115     print "${query_text} ";
1116     print "[$default] ";
1117
1118     $foo = <STDIN>;
1119     ($bar) = split //, $foo;
1120
1121     if ( grep(/\s/, $bar) )
1122     {
1123         # this is debatable.  all whitespace means 'default'
1124
1125         $bar = $default;
1126     }
1127     elsif ($bar eq '')
1128     {
1129         $bar = $default;
1130     }
1131     elsif ($bar ne $default)
1132     {
1133         # everything else means 'nondefault'.
1134
1135         $bar = $nondefault;
1136     }
1137     else
1138     {
1139         # extraneous step.  to get here, $bar should be eq to $default anyway.
1140
1141         $bar = $default;
1142     }
1143
1144     return $bar;
1145 }
1146
1147 ### absolutePath( $file )
1148 #
1149 # converts a given pathname into a canonical path using the abs_path function.
1150 #
1151
1152 sub absolutePath
1153 {
1154     my($file) = @_;
1155     my $home = $ENV{'HOME'};
1156     $file =~ s!~!$home!;
1157     my $startd = cwd();
1158     $file =~ s!^\./!$startd/!;
1159     $file = "$startd/$file" if $file !~ m!^\s*/!;
1160     $file = abs_path($file);
1161     return $file;
1162 }
1163
1164 ### getOwnerID( $file )
1165 #
1166 # return the uid containing the owner ID of the given file.
1167 #
1168
1169 sub getOwnerID
1170 {
1171     my($file) = @_;
1172     my($uid);
1173
1174     #
1175     # call stat() to get the mode of the file
1176     #
1177
1178     $uid = (stat($file))[4];
1179
1180     return $uid;
1181 }
1182
1183 ### getMode( $file )
1184 #
1185 # return a string containing the mode of the given file.
1186 #
1187
1188 sub getMode
1189 {
1190     my($file) = @_;
1191     my($tempmode, $mode);
1192
1193     #
1194     # call stat() to get the mode of the file
1195     #
1196
1197     $tempmode = (stat($file))[2];
1198     if (length($tempmode) < 1)
1199     {
1200         return "";
1201     }
1202
1203     #
1204     # call sprintf to format the mode into a UNIX-like string
1205     #
1206
1207     $mode = sprintf("%04o", $tempmode & 07777);
1208
1209     return $mode;
1210 }
1211
1212 ### userExists( $username )
1213 #
1214 # given a username, return true if the user exists on the system.  return false
1215 # otherwise.
1216 #
1217
1218 sub userExists
1219 {
1220     my($username) = @_;
1221     my($uid);
1222
1223     #
1224     # retrieve the userid of the user with the given username
1225     #
1226
1227     $uid = getpwnam($username);
1228
1229     #
1230     # return true if $uid is defined and has a length greater than 0
1231     #
1232
1233     if ( defined($uid) and (length($uid) > 0) )
1234     {
1235         return 1;
1236     }
1237     else
1238     {
1239         return 0;
1240     }
1241 }