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