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