develooper Front page | perl.perl5.porters | Postings from June 2003

Re: [PATCH 5.8.1 @19053] Getopt::Std

Thread Previous | Thread Next
From:
Ilya Zakharevich
Date:
June 4, 2003 00:46
Subject:
Re: [PATCH 5.8.1 @19053] Getopt::Std
Message ID:
20030604074523.GA7148@math.berkeley.edu
On Mon, May 26, 2003 at 12:32:28AM -0700, Ilya Zakharevich wrote:
> Thinking about this yet a little bit more: I think the following patch
> covers the case when your sysadmin is unsame, *and* works in the
> standard way with very few exceptions (suid/sgid run as root):
> 
> --- ./lib/Getopt/Std.pm-try2	Mon Apr  7 16:33:58 2003
> +++ ./lib/Getopt/Std.pm	Mon May 26 00:29:08 2003
> @@ -71,8 +71,19 @@ and version_mess() with the switches str
>  @ISA = qw(Exporter);
>  @EXPORT = qw(getopt getopts);
>  $VERSION = '1.04';
> +
>  # uncomment the next line to disable 1.03-backward compatibility paranoia
>  # $STANDARD_HELP_VERSION = 1;
> +
> +# Enable standard behaviour if:
> +#   a) we are root (or this does not make sense)
> +#   b) or we are not suid/sgid (or this does not make sense)
> +unless (defined $STANDARD_HELP_VERSION) {
> +  $STANDARD_HELP_VERSION
> +    =  (eval('$< == 0') || 1)
> +   || !(   eval('$< != $>') 
> +	|| eval('$( != $)') );
> +}
>  
>  # Process single-character switches with switch clustering.  Pass one argument
>  # which is a string containing all switches that take an argument.  For each

Well, this definitely won't help when a suid script calls a non-suid
one after switching uids...  So this is not bullet-proof.

Anyway, there is another place to make the --help message more intelligent:

--- ./lib/Getopt/Std.pm-try3	Mon May 26 00:29:08 2003
+++ ./lib/Getopt/Std.pm	Wed Jun  4 00:39:38 2003
@@ -197,11 +197,26 @@ sub help_mess ($;$) {
 	}
 	my ($scr) = ($0 =~ m,([^/\\]+)$,);
 	print $h <<EOH if @_;			# Let the script override this
+
 Usage: $scr [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
 EOH
 	print $h <<EOH;
+
 The following single-character options are accepted:$help
+
 Options may be merged together.  -- stops processing of options.$arg
+EOH
+	my $has_pod;
+	if ( defined $0 and $0 ne '-e' and -f $0 and -r $0
+	     and open my $script, '<', $0 ) {
+	    while (<$script>) {
+		$has_pod = 1, last if /^=(pod|head1)/;
+	    }
+	}
+	print $h <<EOH if $has_pod;
+
+For more details run
+	perldoc -F $0
 EOH
     }
 }

Enjoy,
Ilya

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About