view release on metacpan or  search on metacpan

lib/App/Options.pm  view on Meta::CPAN

                            }
                            else {
                                @env_vars = ( "APP_" . uc($var) );
                            }
                            foreach $env_var (@env_vars) {
                                if ($env_var && defined $ENV{$env_var}) {
                                    $value = $ENV{$env_var};
                                    print STDERR "       Override File Value from Env : var=[$var] value=[$value] from [$env_var] of [@env_vars]\n" if ($debug_options >= 4);
                                    last;
                                }
                            }
                        }
                        # do variable substitutions, var = ${prefix}/bin, var = $ENV{PATH}
                        if (defined $value) {
                            if ($value =~ /\{.*\}/) {
                                $value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} : ($1 eq "prefix" ? $prefix : ""))/eg;
                                $value =~ s/\$ENV\{([a-zA-Z0-9_\.-]+)\}/(defined $ENV{$1} ? $ENV{$1} : "")/eg;
                                print STDERR "         File Var Underwent Substitutions : [$var] = [$value]\n"
                                    if ($debug_options >= 4);
                            }
                            print STDERR "         Var Used : var=[$var] value=[$value]\n" if ($debug_options >= 3);
                            if ($option_defs->{$var} && $option_defs->{$var}{secure} &&
                                defined $values->{security_policy_level} && $values->{security_policy_level} >= 2 && !&file_is_secure($option_file)) {
                                print "Error: \"$var\" may not be supplied from an insecure file because it is a secure option.\n";
                                print "       File: [$option_file]\n";
                                print "       (The file and all of its parent directories must be readable/writable only by the user running the program.)\n";
                                exit(1);
                            }
                            $values->{$var} = $value;    # save all in %App::options
                        }
                    }
                }
            }
            close(App::Options::FILE);

            if ($values->{flush_imports}) {
                @$option_files = ();  # throw out other files to look for
                delete $values->{flush_imports};
            }
            if ($values->{import}) {
                unshift(@$option_files, split(/[,; ]+/, $values->{import}));
                delete $values->{import};
            }
        }
        else {
            print STDERR "\n" if ($debug_options);
        }
    }
}

sub file_is_secure {
    my ($file) = @_;
    my ($secure, $dir);
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
    if ($^O =~ /MSWin32/) {
        $secure = 1; # say it is without really checking
    }
    else {
        $secure = $path_is_secure{$file};
        if (!defined $secure) {
            ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
            if (!($mode & 0400)) {
                $secure = 0;
                print "Error: Option file is not secure because it is not readable by the owner.\n";
            }
            elsif ($mode & 0077) {
                $secure = 0;
                print "Error: Option file is not secure because it is readable/writable by users other than the owner.\n";
            }
            else {
                $dir =~ s!/?[^/]+$!!;
                while ($dir && $secure) {
                    $secure = $path_is_secure{$file};
                    if (!defined $secure) {
                        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$dir/.");  # navigate symlink to the directory
                        if ($uid >= 100 && $uid != $>) {
                            $secure = 0;
                            print "Error: Option file is not secure because a parent directory is owned by a different user.\n";
                            print "       Dir=[$dir]\n";
                        }
                        elsif ($mode & 0077) {
                            $secure = 0;
                            print "Error: Option file is not secure because a parent directory is readable/writable by other users.\n";
                            print "       Dir=[$dir]\n";
                        }
                        $path_is_secure{$file} = 1;  # I don't know this yet, but if we ever get around to asking again, it means that the directory was secure.
                    }
                    $dir =~ s!/?[^/]+$!!;
                }
                $secure = 1 if (!defined $secure);
            }
            $path_is_secure{$file} = $secure;
        }
    }
    return($secure);
}

=head1 LOGIC FLOW: OPTION PROCESSING DETAILS

Basic Concept - By calling App::Options->init(),
your program parses the command line, environment variables,
and option files, and puts var/value pairs into a
global option hash, %App::options.
Just include the following at the top of your program
in order to imbue it with many valuable option-setting
capabilities.

    use App::Options;

When you "use" the App::Options module, the import() method
is called automatically.  This calls the init() method,
passing along all of its parameters.

One of the args to init() is the "values" arg, which allows
for a different hash to be specified as the target of all
option variables and values.

    use App::Options (values => \%Mymodule::opts);

Throughout the following description of option processing,
the %App::options hash may be referred to as the "options hash".
However it will be understood that some other hash (as
specified by the "values" arg) may actually be used.

=head2 Command Line Arguments

Unless the "no_cmd_args" arg is specified to init(), the
first source of option values is the command line.

Each command line argument that begins with a "-" or a "--" is
considered to be an option.  It may take any form such as

    --verbose      # long option, no arg
    --verbose=5    # long option, with arg
    --city=ATL     # long option, with arg