view release on metacpan or  search on metacpan

bin/prefixadmin  view on Meta::CPAN

    my ($self, $options) = @_;
    my ($path, $file, $cwd);
    my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks);

    my $verbose = $options->{verbose} || 0;
    my $prefix  = $options->{prefix} || die "prefix not specified";
    die "$prefix is not a directory" if (! -d $prefix);
    chdir($prefix) || die "Could not change directory to $prefix";

    $path = ".";
    ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($path);
    if ($verbose >= 2) {
        printf("%3d %8d %10s %2d %5d %5d %6d %15d [%17s] %s\n",
            $dev, $ino, $self->format_mode($mode), $nlink, $uid, $gid, $rdev, $size, time2str("%Y-%m-%d %H:%M:%S", $mtime), $path);
    }

    my ($u_name, $u_pass, $u_uid, $u_gid, $u_quota, $u_comment, $u_gcos, $u_dir, $u_shell, $u_expire) = getpwuid($uid);
    print "Uname: $u_name UID: $u_uid\n" if ($verbose >= 2);

    my ($grp_name, $grp_passwd, $grp_gid, $grp_members) = getgrgid($gid);
    print "Gname: $grp_name GID: $grp_gid Members: $grp_members\n" if ($verbose >= 2);

bin/prefixadmin  view on Meta::CPAN

    #print STDERR "   searching $prefix\n" if ($verbose >= 2);
    find(
       sub {
           $file = $_;
           $path = $File::Find::name;
           $path =~ s!^\.\/!!;
           $cwd  = $File::Find::dir;
           $cwd  =~ s!^\.\/!!;
           my ($err_msg);

           ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($file);

           if (!defined $mode) {
               print ">>> $file\n" if ($verbose);
           }
           else {
               printf("%3d %8d %07o:%10s %2d %5d %5d %6d %15d [%17s] %s\n",
                   $dev, $ino, $mode, $self->format_mode($mode), $nlink, $uid, $gid, $rdev, $size, time2str("%Y-%m-%d %H:%M:%S", $mtime), $path) if ($verbose);
               if ($shgrp_gid) {
                   $err_msg = $self->_share_file($file, $options, $shgrp_gid, $mode, $uid, $gid);
               }

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

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";
                        }