]> andersk Git - gssapi-openssh.git/blame - setup/setup-openssh.pl
o Bump to version 2.10.
[gssapi-openssh.git] / setup / setup-openssh.pl
CommitLineData
7a7884ad 1#!/usr/bin/perl
20d3226a 2#
5002372c 3# setup-openssh.pl
4#
95f536ac 5# Adapts the installed gsi-openssh environment to the current machine,
5002372c 6# performing actions that originally occurred during the package's
7# 'make install' phase.
701aa556 8#
1eab725d 9# Send comments/fixes/suggestions to:
10# Chase Phillips <cphillip@ncsa.uiuc.edu>
701aa556 11#
20d3226a 12
7e12c9a7 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
4f276ad7 24$gpath = $ENV{GLOBUS_LOCATION};
ad71c979 25if (!defined($gpath))
26{
21e62476 27 exitDie("ERROR: GLOBUS_LOCATION needs to be set before running this script!\n");
ad71c979 28}
29
7a7884ad 30#
31# Include standard modules
32#
33
34use Getopt::Long;
35use Cwd;
36use Cwd 'abs_path';
37
8b73e3d0 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";
44if (length($oldldpath) > 0)
45{
46 $newldpath .= ":$oldldpath";
47}
48$ENV{LD_LIBRARY_PATH} = "$newldpath";
49
ad71c979 50#
51# i'm including this because other perl scripts in the gpt setup directories
52# do so
53#
54
7e12c9a7 55if (defined($gptpath))
56{
57 @INC = (@INC, "$gptpath/lib/perl", "$gpath/lib/perl");
58}
59else
60{
61 @INC = (@INC, "$gpath/lib/perl");
62}
ad71c979 63
4f276ad7 64require Grid::GPT::Setup;
65
7a7884ad 66#
67# script-centred variable initialization
68#
69
ad71c979 70my $globusdir = $gpath;
ad71c979 71my $myname = "setup-openssh.pl";
72
20d3226a 73#
74# Set up path prefixes for use in the path translations
75#
76
d0a1bda7 77$prefix = ${globusdir};
78$exec_prefix = "${prefix}";
9e0b5296 79$bindir = "${exec_prefix}/bin/ssh.d";
9cc10d0e 80$sbindir = "${exec_prefix}/sbin";
95f536ac 81$sysconfdir = "$prefix/etc/ssh";
82$localsshdir = "/etc/ssh";
20bb6dc8 83$setupdir = "$prefix/setup/gsi_openssh_setup";
e9ec5455 84
7a7884ad 85#
86# standard key types and their root file name mappings
87#
88
95f536ac 89my $keyfiles = {
90 "dsa" => "ssh_host_dsa_key",
91 "rsa" => "ssh_host_rsa_key",
92 "rsa1" => "ssh_host_key",
93 };
823981ba 94
7a7884ad 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
571ab952 100my($prompt, $force, $verbose);
7a7884ad 101
bf1ee591 102$prompt = 1;
15ff71ab 103$verbose = 0;
bf1ee591 104
7a7884ad 105GetOptions(
571ab952 106 'prompt!' => \$prompt,
7a7884ad 107 'force' => \$force,
108 'verbose' => \$verbose,
109 ) or pod2usage(2);
110
2c034b75 111#
112# miscellaneous initialization functions
113#
114
115setPrivilegeSeparation(0);
116
7a7884ad 117#
118# main execution. This should find its way into a subroutine at some future
119# point.
120#
121
12d3602b 122debug0("Configuring gsi_openssh\n");
123debug0("------------------------------------------------------------\n");
124debug0("Executing...\n");
4f3224f2 125
126makeConfDir();
614e6d8b 127copyPRNGFile();
4f3224f2 128$keyhash = determineKeys();
129runKeyGen($keyhash->{gen});
34e7131d 130linkKeyFiles($keyhash->{link});
4f3224f2 131copyConfigFiles();
4f3224f2 132
133my $metadata = new Grid::GPT::Setup(package_name => "gsi_openssh_setup");
134
135$metadata->finish();
136
12d3602b 137debug0("\n");
15ff71ab 138debug0("Notes:\n\n");
139
140if ( getPrivilegeSeparation() )
b48c75c0 141{
15ff71ab 142 debug0(" o Privilege separation is on.\n");
b48c75c0 143}
15ff71ab 144elsif ( !getPrivilegeSeparation() )
571ab952 145{
15ff71ab 146 debug0(" o Privilege separation is off.\n");
571ab952 147}
ff3b2ddb 148
15ff71ab 149debug0(" o GSI-OpenSSH website is <http://grid.ncsa.uiuc.edu/ssh/>.\n");
12d3602b 150debug0("------------------------------------------------------------\n");
151debug0("Finished configuring gsi_openssh.\n");
4f3224f2 152
153exit;
154
155#
156# subroutines
157#
158
7a7884ad 159### initPRNGHash( )
160#
161# initialize the PRNG pathname hash
162#
163
164sub 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
15ff71ab 187 debug1("Determining paths for PRNG commands...\n");
7a7884ad 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
200sub 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
231sub 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
244sub copyPRNGFile
245{
246 my($fileInput, $fileOutput);
247 my($mode, $uid, $gid);
248 my($data);
249
64545db1 250 if ( isPresent("$sysconfdir/ssh_prng_cmds") && !isForced() )
7a7884ad 251 {
15ff71ab 252 debug1("ssh_prng_cmds found and not forced. Not installing ssh_prng_cmds...\n");
7a7884ad 253 return;
254 }
255
256 initPRNGHash();
257
15ff71ab 258 debug1("Fixing paths in ssh_prng_cmds...\n");
7a7884ad 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 {
15ff71ab 269 debug1("Cannot read $fileInput... skipping.\n");
7a7884ad 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
319sub 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
341sub 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
363sub 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
375sub 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
387sub 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
399sub 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
412sub 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
34e7131d 429### linkKeyFiles( $linklist )
4f3224f2 430#
34e7131d 431# given an array of keys to link, link both the key and its public variant into
4f3224f2 432# the gsi-openssh configuration directory.
433#
434
34e7131d 435sub linkKeyFiles
e9ec5455 436{
34e7131d 437 my($linklist) = @_;
95f536ac 438 my($regex, $basename);
e9ec5455 439
34e7131d 440 if (@$linklist)
e9ec5455 441 {
34e7131d 442 debug1("Linking ssh host keys...\n");
e9ec5455 443
34e7131d 444 for my $f (@$linklist)
95f536ac 445 {
712b003f 446 $f =~ s:/+:/:g;
447
448 if (length($f) > 0)
449 {
450 $keyfile = "$f";
451 $pubkeyfile = "$f.pub";
95f536ac 452
34e7131d 453 linkFile("$localsshdir/$keyfile", "$sysconfdir/$keyfile");
454 linkFile("$localsshdir/$pubkeyfile", "$sysconfdir/$pubkeyfile");
712b003f 455 }
95f536ac 456 }
e9ec5455 457 }
e9ec5455 458}
459
7a7884ad 460### isForced( )
461#
462# return true if the user passed in the force flag. return false otherwise.
463#
464
465sub isForced
466{
467 if ( defined($force) && $force )
468 {
469 return 1;
470 }
471 else
472 {
473 return 0;
474 }
475}
476
4f3224f2 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
95f536ac 483sub isReadable
1a1f62a4 484{
95f536ac 485 my($file) = @_;
1a1f62a4 486
95f536ac 487 if ( ( -e $file ) && ( -r $file ) )
1a1f62a4 488 {
95f536ac 489 return 1;
1a1f62a4 490 }
823981ba 491 else
1a1f62a4 492 {
95f536ac 493 return 0;
ac083f7a 494 }
1a1f62a4 495}
496
7a7884ad 497### isExecutable( $file )
498#
499# return true if $file is executable. return false otherwise.
500#
501
502sub 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
522sub 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
4f3224f2 536### isPresent( $file )
537#
538# given a file, return true if that file exists. return false otherwise.
539#
540
712b003f 541sub isPresent
542{
543 my($file) = @_;
544
545 if ( -e $file )
546 {
547 return 1;
548 }
549 else
550 {
551 return 0;
552 }
553}
554
c096bf39 555### makeConfDir( )
556#
557# make the gsi-openssh configuration directory if it doesn't already exist.
558#
559
560sub makeConfDir
561{
562 if ( isPresent($sysconfdir) )
563 {
564 if ( -d $sysconfdir )
565 {
566 return;
567 }
568
15ff71ab 569 debug1("${sysconfdir} already exists and is not a directory!\n");
74d5d582 570 exit;
c096bf39 571 }
572
15ff71ab 573 debug1("Could not find ${sysconfdir} directory... creating.\n");
c096bf39 574 action("mkdir -p $sysconfdir");
575
576 return;
577}
578
4f3224f2 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
95f536ac 586sub determineKeys
823981ba 587{
95f536ac 588 my($keyhash, $keylist);
589 my($count);
823981ba 590
712b003f 591 #
592 # initialize our variables
593 #
594
95f536ac 595 $count = 0;
823981ba 596
95f536ac 597 $keyhash = {};
598 $keyhash->{gen} = []; # a list of keytypes to generate
34e7131d 599 $keyhash->{link} = []; # a list of files to link
712b003f 600
95f536ac 601 $genlist = $keyhash->{gen};
34e7131d 602 $linklist = $keyhash->{link};
e9ec5455 603
712b003f 604 #
605 # loop over our keytypes and determine what we need to do for each of them
606 #
607
95f536ac 608 for my $keytype (keys %$keyfiles)
1a1f62a4 609 {
95f536ac 610 $basekeyfile = $keyfiles->{$keytype};
1a1f62a4 611
712b003f 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) )
95f536ac 620 {
7a7884ad 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 }
95f536ac 633 }
1a1f62a4 634
712b003f 635 #
34e7131d 636 # if we can find a copy of the keys in /etc/ssh, we'll link them to the user's
712b003f 637 # globus location
638 #
639
640 $mainkeyfile = "$localsshdir/$basekeyfile";
641 $mainpubkeyfile = "$localsshdir/$basekeyfile.pub";
642
643 if ( isReadable($mainkeyfile) && isReadable($mainpubkeyfile) )
95f536ac 644 {
34e7131d 645 push(@$linklist, $basekeyfile);
95f536ac 646 $count++;
712b003f 647 next;
95f536ac 648 }
712b003f 649
650 #
651 # otherwise, we need to generate the key
652 #
653
654 push(@$genlist, $keytype);
655 $count++;
1a1f62a4 656 }
657
95f536ac 658 return $keyhash;
659}
660
4f3224f2 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
95f536ac 667sub runKeyGen
668{
669 my($gen_keys) = @_;
ce935927 670 my $keygen = "$bindir/ssh-keygen";
95f536ac 671
ce935927 672 if (@$gen_keys && -x $keygen)
1a1f62a4 673 {
15ff71ab 674 debug1("Generating ssh host keys...\n");
712b003f 675
676 for my $k (@$gen_keys)
677 {
678 $keyfile = $keyfiles->{$k};
95f536ac 679
7a7884ad 680 if ( !isPresent("$sysconfdir/$keyfile") )
681 {
682 action("$bindir/ssh-keygen -t $k -f $sysconfdir/$keyfile -N \"\"");
683 }
712b003f 684 }
1a1f62a4 685 }
686
687 return 0;
688}
689
7a7884ad 690### copySSHDConfigFile( )
5b105785 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
7a7884ad 696sub copySSHDConfigFile
20d3226a 697{
5b105785 698 my($fileInput, $fileOutput);
699 my($mode, $uid, $gid);
700 my($line, $newline);
b48c75c0 701 my($privsep_enabled);
823981ba 702
15ff71ab 703 debug1("Fixing paths in sshd_config...\n");
95f536ac 704
5b105785 705 $fileInput = "$setupdir/sshd_config.in";
706 $fileOutput = "$sysconfdir/sshd_config";
95f536ac 707
7a7884ad 708 #
709 # verify that we are prepared to work with $fileInput
710 #
711
712 if ( !isReadable($fileInput) )
95f536ac 713 {
15ff71ab 714 debug1("Cannot read $fileInput... skipping.\n");
7a7884ad 715 return;
5b105785 716 }
717
7a7884ad 718 #
719 # verify that we are prepared to work with $fileOuput
720 #
721
722 if ( !prepareFileWrite($fileOutput) )
5b105785 723 {
7a7884ad 724 return;
95f536ac 725 }
e9ec5455 726
b48c75c0 727 #
728 # check to see whether we should enable privilege separation
729 #
730
8c2b2cf1 731 if ( userExists("sshd") && ( -d "/var/empty" ) && ( getOwnerID("/var/empty") eq 0 ) )
b48c75c0 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
20d3226a 749 #
95f536ac 750 # Grab the current mode/uid/gid for use later
20d3226a 751 #
752
5b105785 753 $mode = (stat($fileInput))[2];
754 $uid = (stat($fileInput))[4];
755 $gid = (stat($fileInput))[5];
20d3226a 756
20d3226a 757 #
5b105785 758 # Open the files for reading and writing, and loop over the input's contents
20d3226a 759 #
760
b48c75c0 761 $data = readFile($fileInput);
20d3226a 762
fb6517a6 763 # #
764 # # alter the PidFile config
765 # #
766 #
767 # $text = "PidFile\t$gpath/var/sshd.pid";
768 # $data =~ s:^[\s|#]*PidFile.*$:$text:gm;
eb4172f6 769
b48c75c0 770 #
771 # set the sftp directive
772 #
7c96a399 773
b84327f8 774 $text = "Subsystem\tsftp\t$gpath/libexec/sftp-server";
b48c75c0 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);
7c96a399 789
95f536ac 790 #
791 # An attempt to revert the new file back to the original file's
792 # mode/uid/gid
793 #
7e12c9a7 794
5b105785 795 chmod($mode, $fileOutput);
796 chown($uid, $gid, $fileOutput);
20d3226a 797
798 return 0;
799}
800
b48c75c0 801### setPrivilegeSeparation( $value )
802#
803# set the privilege separation variable to $value
804#
805
806sub 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
818sub getPrivilegeSeparation
819{
820 return $privsep;
821}
822
7a7884ad 823### prepareFileWrite( $file )
824#
825# test $file to prepare for writing to it.
826#
827
828sub prepareFileWrite
829{
830 my($file) = @_;
831
832 if ( isPresent($file) )
833 {
15ff71ab 834 debug1("$file already exists... ");
7a7884ad 835
836 if ( isForced() )
837 {
838 if ( isWritable($file) )
839 {
15ff71ab 840 debug1("removing.\n");
7a7884ad 841 action("rm $file");
842 return 1;
843 }
844 else
845 {
15ff71ab 846 debug1("not writable -- skipping.\n");
7a7884ad 847 return 0;
848 }
849 }
850 else
851 {
15ff71ab 852 debug1("skipping.\n");
7a7884ad 853 return 0;
854 }
855 }
856
857 return 1;
858}
859
5b105785 860### copyConfigFiles( )
861#
862# subroutine that copies some extra config files to their proper location in
863# $GLOBUS_LOCATION/etc/ssh.
864#
865
866sub copyConfigFiles
867{
7a7884ad 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
15ff71ab 879 debug1("Copying ssh_config and moduli to their proper location...\n");
7a7884ad 880
881 copyFile("$setupdir/ssh_config", "$sysconfdir/ssh_config");
882 copyFile("$setupdir/moduli", "$sysconfdir/moduli");
5b105785 883
7a7884ad 884 #
885 # copy and alter the SXXsshd script.
886 #
887
888 copySXXScript("$setupdir/SXXsshd.in", "$sbindir/SXXsshd");
5b105785 889}
890
34e7131d 891### linkFile( $src, $dest )
892#
893# create a symbolic link from $src to $dest.
894#
895
896sub linkFile
897{
898 my($src, $dest) = @_;
899
900 if ( !isReadable($src) )
901 {
902 debug1("$src is not readable... not creating $dest.\n");
903 return;
904 }
905
906 if ( !prepareFileWrite($dest) )
907 {
908 return;
909 }
910
911 action("ln -s $src $dest");
912}
913
7a7884ad 914### copyFile( $src, $dest )
4f3224f2 915#
7a7884ad 916# copy the file pointed to by $src to the location specified by $dest. in the
917# process observe the rules regarding when the '-force' flag was passed to us.
4f3224f2 918#
919
7a7884ad 920sub copyFile
a26c150d 921{
7a7884ad 922 my($src, $dest) = @_;
d58b3a33 923
7a7884ad 924 if ( !isReadable($src) )
20bb6dc8 925 {
15ff71ab 926 debug1("$src is not readable... not creating $dest.\n");
7a7884ad 927 return;
20bb6dc8 928 }
7a7884ad 929
930 if ( !prepareFileWrite($dest) )
931 {
932 return;
933 }
934
935 action("cp $src $dest");
d58b3a33 936}
937
7a7884ad 938### copySXXScript( $in, $out )
4f3224f2 939#
7a7884ad 940# parse the input file, substituting in place the value of GLOBUS_LOCATION, and
941# write the result to the output file.
4f3224f2 942#
943
7a7884ad 944sub copySXXScript
d58b3a33 945{
7a7884ad 946 my($in, $out) = @_;
b1282c82 947 my($tmpgpath);
7a7884ad 948
949 if ( !isReadable($in) )
950 {
15ff71ab 951 debug1("$in is not readable... not creating $out.\n");
7a7884ad 952 return;
953 }
954
955 if ( !prepareFileWrite($out) )
956 {
957 return;
958 }
959
b1282c82 960 #
961 # clean up any junk in the globus path variable
962 #
963
964 $tmpgpath = $gpath;
965 $tmpgpath =~ s:/+:/:g;
966 $tmpgpath =~ s:([^/]+)/$:\1:g;
967
968 #
969 # read in the script, substitute globus location, then write it back out
970 #
971
7a7884ad 972 $data = readFile($in);
b1282c82 973 $data =~ s|\@GLOBUS_LOCATION\@|$tmpgpath|g;
7a7884ad 974 writeFile($out, $data);
975 action("chmod 755 $out");
a26c150d 976}
977
978### readFile( $filename )
979#
980# reads and returns $filename's contents
981#
982
983sub readFile
984{
7a7884ad 985 my($filename) = @_;
986 my($data);
a26c150d 987
21e62476 988 open(IN, "$filename") || exitDie("ERROR: Can't open '$filename': $!\n");
a26c150d 989 $/ = undef;
990 $data = <IN>;
991 $/ = "\n";
992 close(IN);
993
994 return $data;
995}
996
997### writeFile( $filename, $fileinput )
998#
999# create the inputs to the ssl program at $filename, appending the common name to the
1000# stream in the process
1001#
1002
1003sub writeFile
1004{
7a7884ad 1005 my($filename, $fileinput) = @_;
a26c150d 1006
1007 #
1008 # test for a valid $filename
1009 #
1010
1011 if ( !defined($filename) || (length($filename) lt 1) )
1012 {
21e62476 1013 exitDie("ERROR: Filename is undefined!\n");
a26c150d 1014 }
1015
7a7884ad 1016 #
1017 # verify that we are prepared to work with $filename
1018 #
1019
1020 if ( !prepareFileWrite($filename) )
a26c150d 1021 {
7a7884ad 1022 return;
a26c150d 1023 }
1024
1025 #
1026 # write the output to $filename
1027 #
1028
1029 open(OUT, ">$filename");
1030 print OUT "$fileinput";
1031 close(OUT);
1032}
1033
15ff71ab 1034### debug1( $arg1, $arg2 )
1035#
1036# Print out a debugging message at level 1.
1037#
1038
1039sub debug1
1040{
1041 debug(string => \@_, level => 1);
1042}
1043
1044### debug0( $arg1, $arg2 )
1045#
1046# Print out a debugging message at level 0.
1047#
1048
1049sub debug0
1050{
1051 debug(string => \@_, level => 0);
1052}
1053
1054### debug( string => $string, level => $level )
1055#
1056# Print out debugging messages at various levels. Feel free to use debugN() directly
1057# which in turn calls this subroutine.
1058#
1059
1060sub debug
1061{
1062 my %args = @_;
1063
1064 if (!defined($args{'level'}))
1065 {
1066 $args{'level'} = 0;
1067 }
1068
1069 if ($verbose >= $args{'level'})
1070 {
1071 printf(@{$args{'string'}});
1072 }
1073}
1074
7a7884ad 1075### action( $command )
ac083f7a 1076#
7a7884ad 1077# run $command within a proper system() command.
ac083f7a 1078#
1079
1080sub action
1081{
7a7884ad 1082 my($command) = @_;
ac083f7a 1083
15ff71ab 1084 debug1("$command\n");
ac083f7a 1085
15ff71ab 1086 my $result = system("LD_LIBRARY_PATH=\"$gpath/lib:\$LD_LIBRARY_PATH\"; $command >/dev/null 2>&1");
ac083f7a 1087
1088 if (($result or $?) and $command !~ m!patch!)
1089 {
21e62476 1090 exitDie("ERROR: Unable to execute command: $!\n");
ac083f7a 1091 }
1092}
1093
74d5d582 1094### exitDie( $error )
1095#
1096# a horribly named method meant to look like die but only exit, thereby not causing
1097# gpt-postinstall to croak.
1098#
1099
1100sub exitDie
1101{
1102 my($error) = @_;
1103
1104 print $error;
1105 exit;
1106}
1107
7a7884ad 1108### query_boolean( $query_text, $default )
1109#
1110# query the user with a string, and expect a response. If the user hits
1111# 'enter' instead of entering an input, then accept the default response.
1112#
1113
ac083f7a 1114sub query_boolean
1115{
7a7884ad 1116 my($query_text, $default) = @_;
1117 my($nondefault, $foo, $bar);
ac083f7a 1118
bf1ee591 1119 if ( !$prompt )
571ab952 1120 {
1121 print "Prompt suppressed. Continuing...\n";
1122 return "y";
1123 }
1124
ac083f7a 1125 #
1126 # Set $nondefault to the boolean opposite of $default.
1127 #
1128
1129 if ($default eq "n")
1130 {
1131 $nondefault = "y";
1132 }
1133 else
1134 {
1135 $nondefault = "n";
1136 }
1137
1138 print "${query_text} ";
1139 print "[$default] ";
1140
e9ec5455 1141 $foo = <STDIN>;
1142 ($bar) = split //, $foo;
1143
e9d69a89 1144 if ( grep(/\s/, $bar) )
ac083f7a 1145 {
e9d69a89 1146 # this is debatable. all whitespace means 'default'
1147
1148 $bar = $default;
1149 }
be47d94e 1150 elsif ($bar eq '')
1151 {
1152 $bar = $default;
1153 }
e9d69a89 1154 elsif ($bar ne $default)
1155 {
1156 # everything else means 'nondefault'.
1157
1158 $bar = $nondefault;
1159 }
1160 else
1161 {
1162 # extraneous step. to get here, $bar should be eq to $default anyway.
1163
e9ec5455 1164 $bar = $default;
ac083f7a 1165 }
1166
e9ec5455 1167 return $bar;
ac083f7a 1168}
c096bf39 1169
1170### absolutePath( $file )
1171#
1172# converts a given pathname into a canonical path using the abs_path function.
1173#
1174
1175sub absolutePath
1176{
1177 my($file) = @_;
1178 my $home = $ENV{'HOME'};
1179 $file =~ s!~!$home!;
1180 my $startd = cwd();
1181 $file =~ s!^\./!$startd/!;
1182 $file = "$startd/$file" if $file !~ m!^\s*/!;
1183 $file = abs_path($file);
1184 return $file;
1185}
b48c75c0 1186
8c2b2cf1 1187### getOwnerID( $file )
1188#
1189# return the uid containing the owner ID of the given file.
1190#
1191
1192sub getOwnerID
1193{
1194 my($file) = @_;
1195 my($uid);
1196
1197 #
1198 # call stat() to get the mode of the file
1199 #
1200
1201 $uid = (stat($file))[4];
1202
1203 return $uid;
1204}
1205
b48c75c0 1206### getMode( $file )
1207#
1208# return a string containing the mode of the given file.
1209#
1210
1211sub getMode
1212{
1213 my($file) = @_;
1214 my($tempmode, $mode);
1215
1216 #
1217 # call stat() to get the mode of the file
1218 #
1219
1220 $tempmode = (stat($file))[2];
1221 if (length($tempmode) < 1)
1222 {
1223 return "";
1224 }
1225
1226 #
1227 # call sprintf to format the mode into a UNIX-like string
1228 #
1229
1230 $mode = sprintf("%04o", $tempmode & 07777);
1231
1232 return $mode;
1233}
1234
1235### userExists( $username )
1236#
1237# given a username, return true if the user exists on the system. return false
1238# otherwise.
1239#
1240
1241sub userExists
1242{
1243 my($username) = @_;
1244 my($uid);
1245
1246 #
1247 # retrieve the userid of the user with the given username
1248 #
1249
1250 $uid = getpwnam($username);
1251
1252 #
1253 # return true if $uid is defined and has a length greater than 0
1254 #
1255
1256 if ( defined($uid) and (length($uid) > 0) )
1257 {
1258 return 1;
1259 }
1260 else
1261 {
1262 return 0;
1263 }
1264}
This page took 0.254878 seconds and 5 git commands to generate.