ALT Linux Sisyphus - Пакет perl-Privileges-Drop

Privileges-Drop-1.03/000075500000000000000000000000001163671517300144605ustar00rootroot00000000000000Privileges-Drop-1.03/Build.PL000064400000000000000000000011511163671517300157520ustar00rootroot00000000000000use strict;
use warnings;
use Module::Build;

my $builder = Module::Build->new(
    module_name        => 'Privileges::Drop',
    license            => 'perl',
    dist_author        => 'Troels Liebe Bentsen <troels@infopro.dk>',
    dist_version_from  => 'lib/Privileges/Drop.pm',
    create_makefile_pl => 'passthrough',
    create_readme      => 1,
    requires => {
        'Carp'    => 0,
        'English' => 0,
    },
    build_requires => {
        'Test::More' => 0,
    },
    add_to_cleanup => [ 
        'Privileges-Drop-*',
        'Makefile',
        'blib',
    ],
);

$builder->create_build_script();
Privileges-Drop-1.03/ChangeLog000064400000000000000000000007361163671517300162400ustar00rootroot00000000000000Version 1.02 (Tue Sep 20 2011)
 * Drop perl version check in Build.PL as this is cause problems.

Version 1.01 (Wed May 6 2009)
 * Fixed a bug in how GID was set.
 * Thanks to Andreas Wundsam <andi@net.t-labs.tu-berlin.de> for providing code
   example showing how to fix bug.
 * Redid the compare method to handle Perl's varying returns from GID
 * Thanks to Erik Wasser <erik.wasser@iquer.net> for reporting this bug. 

Version 1.00 (Tue Sep 4 2007)
 * First version released
Privileges-Drop-1.03/MANIFEST000064400000000000000000000002721163671517300156120ustar00rootroot00000000000000Build.PL
ChangeLog
examples/drop.pl
lib/Privileges/Drop.pm
MANIFEST
MANIFEST.SKIP
META.yml
README
t/critic.t
t/dropuidgid.t
t/perlcriticrc
t/pod-coverage.t
t/pod.t
Makefile.PL
META.json
Privileges-Drop-1.03/MANIFEST.SKIP000064400000000000000000000011301163671517300163510ustar00rootroot00000000000000# Avoid version control files.
\bRCS\b
\bCVS\b
,v$
\B\.svn\b
\B\.cvsignore$
\B\.git\b
\B\.gitignore$

# Avoid Makemaker generated and utility files.
\bMakefile$
\bblib
\bMakeMaker-\d
\bpm_to_blib$
\bblibdirs$
^MANIFEST\.SKIP$

# Avoid Module::Build generated and utility files.
\bBuild$
\bBuild.bat$
\b_build

# Avoid Devel::Cover generated files
\bcover_db

# Avoid temp and backup files.
~$
\.tmp$
\.old$
\.bak$
\#$
\.#
\.rej$

# Avoid OS-specific files/dirs
#   Mac OSX metadata
\B\.DS_Store
#   Mac OSX SMB mount metadata files
\B\._
# Avoid archives of this distribution
\bIO-Buffered-[\d\.\_]+
Privileges-Drop-1.03/META.json000064400000000000000000000020611163671517300161000ustar00rootroot00000000000000{
   "abstract" : "A module to make it simple to drop all privileges, even \nPOSIX groups.",
   "author" : [
      "Troels Liebe Bentsen <troels@infopro.dk>"
   ],
   "dynamic_config" : 1,
   "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.110930",
   "license" : [
      "perl_5"
   ],
   "meta-spec" : {
      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
      "version" : "2"
   },
   "name" : "Privileges-Drop",
   "prereqs" : {
      "build" : {
         "requires" : {
            "Test::More" : 0
         }
      },
      "configure" : {
         "requires" : {
            "Module::Build" : "0.38"
         }
      },
      "runtime" : {
         "requires" : {
            "Carp" : 0,
            "English" : 0
         }
      }
   },
   "provides" : {
      "Privileges::Drop" : {
         "file" : "lib/Privileges/Drop.pm",
         "version" : "1.03"
      }
   },
   "release_status" : "stable",
   "resources" : {
      "license" : [
         "http://dev.perl.org/licenses/"
      ]
   },
   "version" : "1.03"
}
Privileges-Drop-1.03/META.yml000064400000000000000000000011571163671517300157350ustar00rootroot00000000000000---
abstract: "A module to make it simple to drop all privileges, even \nPOSIX groups."
author:
  - 'Troels Liebe Bentsen <troels@infopro.dk>'
build_requires:
  Test::More: 0
configure_requires:
  Module::Build: 0.38
dynamic_config: 1
generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110930'
license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: 1.4
name: Privileges-Drop
provides:
  Privileges::Drop:
    file: lib/Privileges/Drop.pm
    version: 1.03
requires:
  Carp: 0
  English: 0
resources:
  license: http://dev.perl.org/licenses/
version: 1.03
Privileges-Drop-1.03/Makefile.PL000064400000000000000000000022631163671517300164350ustar00rootroot00000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.3800

    unless (eval "use Module::Build::Compat 0.02; 1" ) {
      print "This module requires Module::Build to install itself.\n";

      require ExtUtils::MakeMaker;
      my $yn = ExtUtils::MakeMaker::prompt
	('  Install Module::Build now from CPAN?', 'y');

      unless ($yn =~ /^y/i) {
	die " *** Cannot install without Module::Build.  Exiting ...\n";
      }

      require Cwd;
      require File::Spec;
      require CPAN;

      # Save this 'cause CPAN will chdir all over the place.
      my $cwd = Cwd::cwd();

      CPAN::Shell->install('Module::Build::Compat');
      CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
	or die "Couldn't install Module::Build, giving up.\n";

      chdir $cwd or die "Cannot chdir() back to $cwd: $!";
    }
    eval "use Module::Build::Compat 0.02; 1" or die $@;

    Module::Build::Compat->run_build_pl(args => \@ARGV);
    my $build_script = 'Build';
    $build_script .= '.com' if $^O eq 'VMS';
    exit(0) unless(-e $build_script); # cpantesters convention
    require Module::Build;
    Module::Build::Compat->write_makefile(build_class => 'Module::Build');
Privileges-Drop-1.03/README000064400000000000000000000037511163671517300153460ustar00rootroot00000000000000NAME
    Privileges::Drop - A module to make it simple to drop all privileges,
    even POSIX groups.

DESCRIPTION
    This module tries to simplify the process of dropping privileges. This
    can be useful when your Perl program needs to bind to privileged ports,
    etc. This module is much like Proc::UID, except that it's implemented in
    pure Perl. Special care has been taken to also drop saved uid on
    platforms that support this, currently only test on on Linux.

SYNOPSIS
      use Privileges::Drop;

      # Do privileged stuff

      # Drops privileges and sets euid/uid to 1000 and egid/gid to 1000.
      drop_uidgid(1000, 1000);

      # Drop privileges to user nobody looking up gid and uid with getpwname
      # This also set the enviroment variables USER, LOGNAME, HOME and SHELL. 
      drop_privileges('nobody');

METHODS
    drop_uidgid($uid, $gid, @groups)
        Drops privileges and sets euid/uid to $uid and egid/gid to $gid.

        Supplementary groups can be set in @groups.

    drop_privileges($user)
        Drops privileges to the $user, looking up gid and uid with getpwname
        and calling drop_uidgid() with these arguments.

        The environment variables USER, LOGNAME, HOME and SHELL are also set
        to the values returned by getpwname.

        Returns the $uid and $gid on success and dies on error.

        NOTE: If drop_privileges() is called when you don't have root
        privileges it will just return undef;

NOTES
    As this module only uses Perl's build in function, it relies on them to
    work correctly. That means setting $GID and $EGID should also call
    setgroups(), something that might not have been the case before Perl
    5.004. So if you are running an older version, Proc::UID might be a
    better choice.

AUTHOR
    Troels Liebe Bentsen <tlb@rapanden.dk>

COPYRIGHT
    Copyright(C) 2007-2009 Troels Liebe Bentsen

    This library is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.

Privileges-Drop-1.03/examples/000075500000000000000000000000001163671517300162765ustar00rootroot00000000000000Privileges-Drop-1.03/examples/drop.pl000075500000000000000000000005101163671517300175760ustar00rootroot00000000000000#!/usr/bin/env perl 
use strict;
use warnings;

use Privileges::Drop;

my $user = shift or "die ./drop.pl user";

system("id");
my ($uid, $gid) = drop_privileges($user) or die "Could not drop privileges";
print "Current UID is $uid, GID is $gid\n";
system("id");
if(-f "/proc/$$/status") {
    system("cat /proc/$$/status");
}

Privileges-Drop-1.03/lib/000075500000000000000000000000001163671517300152265ustar00rootroot00000000000000Privileges-Drop-1.03/lib/Privileges/000075500000000000000000000000001163671517300173375ustar00rootroot00000000000000Privileges-Drop-1.03/lib/Privileges/Drop.pm000064400000000000000000000117661163671517300206140ustar00rootroot00000000000000package Privileges::Drop;
use strict;
use warnings;
use English qw( -no_match_vars );
use Carp;

our $VERSION = '1.03';

=head1 NAME

Privileges::Drop - A module to make it simple to drop all privileges, even 
POSIX groups.

=head1 DESCRIPTION

This module tries to simplify the process of dropping privileges. This can be
useful when your Perl program needs to bind to privileged ports, etc. This
module is much like Proc::UID, except that it's implemented in pure Perl.
Special care has been taken to also drop saved uid on platforms that support
this, currently only test on on Linux.

=head1 SYNOPSIS

  use Privileges::Drop;

  # Do privileged stuff

  # Drops privileges and sets euid/uid to 1000 and egid/gid to 1000.
  drop_uidgid(1000, 1000);

  # Drop privileges to user nobody looking up gid and uid with getpwname
  # This also set the enviroment variables USER, LOGNAME, HOME and SHELL. 
  drop_privileges('nobody');

=head1 METHODS

=over

=cut

use base "Exporter";

our @EXPORT = qw(drop_privileges drop_uidgid);

=item drop_uidgid($uid, $gid, @groups)

Drops privileges and sets euid/uid to $uid and egid/gid to $gid.

Supplementary groups can be set in @groups.

=cut

sub drop_uidgid {
    my ($uid, $gid, @reqPosixGroups) = @_;

    # Sort the groups and make sure they are uniq
    my %groupHash = map { $_ => 1 } ($gid, @reqPosixGroups);
    my $newgid ="$gid ".join(" ", sort { $a <=> $b } (keys %groupHash));

    # Description from:
    # http://www.mail-archive.com/perl5-changes@perl.org/msg02683.html
    #
    # According to Stevens' APUE and various
    # (BSD, Solaris, HP-UX) man pages setting
    # the real uid first and effective uid second
    # is the way to go if one wants to drop privileges,
    # because if one changes into an effective uid of
    # non-zero, one cannot change the real uid any more.
    #
    # Actually, it gets even messier.  There is
    # a third uid, called the saved uid, and as
    # long as that is zero, one can get back to
    # uid of zero.  Setting the real-effective *twice*
    # helps in *most* systems (FreeBSD and Solaris)
    # but apparently in HP-UX even this doesn't help:
    # the saved uid stays zero (apparently the only way
    # in HP-UX to change saved uid is to call setuid()
    # when the effective uid is zero).

    # Drop privileges to $uid and $gid for both effective and saved uid/gid
    ($GID) = split /\s/, $newgid;
    $EGID = $newgid;
    $EUID = $UID = $uid;

    # To overwrite the saved UID on all platforms we need to do it twice
    ($GID) = split /\s/, $newgid;
    $EGID = $newgid;
    $EUID = $UID = $uid;

    # Sort the output so we can compare it
    my %GIDHash = map { $_ => 1 } ($gid, split(/\s/, $GID));
    my $cgid = int($GID)." ".join(" ", sort { $a <=> $b } (keys %GIDHash));
    my %EGIDHash = map { $_ => 1 } ($gid, split(/\s/, $EGID));
    my $cegid = int($EGID)." ".join(" ", sort { $a <=> $b } (keys %EGIDHash));

    # Check that we did actually drop the privileges
    if($UID ne $uid or $EUID ne $uid or $cgid ne $newgid or $cegid ne $newgid) {
        croak("Could not drop privileges to uid:$uid, gid:$newgid\n"
            ."Currently is: UID:$UID, EUID=$EUID, GID=$cgid, EGID=$cegid\n");
    }
}

=item drop_privileges($user)

Drops privileges to the $user, looking up gid and uid with getpwname and 
calling drop_uidgid() with these arguments.

The environment variables USER, LOGNAME, HOME and SHELL are also set to the
values returned by getpwname.

Returns the $uid and $gid on success and dies on error.

NOTE: If drop_privileges() is called when you don't have root privileges
it will just return undef;

=cut

sub drop_privileges {
    my ($user) = @_;

    croak "No user give" if !defined $user;

    # Check if we are root and stop if we are not.
    if($UID != 0 and $EUID != 0) {
        return;
    }

    # Find user in passwd file
    my ($uid, $gid, $home, $shell) = (getpwnam($user))[2,3,7,8];
    if(!defined $uid or !defined $gid) {
        croak("Could not find uid and gid user $user");
    }

    # Find all the groups the user is a member of
    my @groups;
    while (my ($name, $comment, $ggid, $mstr) = getgrent()) {
        my %membership = map { $_ => 1 } split(/\s/, $mstr);
        if(exists $membership{$user}) {
            push(@groups, $ggid) if $ggid ne 0;
        }
    }

    # Cleanup $ENV{}
    $ENV{USER} = $user;
    $ENV{LOGNAME} = $user;
    $ENV{HOME} = $home;
    $ENV{SHELL} = $shell;

    drop_uidgid($uid, $gid, @groups);

    return ($uid, $gid, @groups);
}

=back

=head1 NOTES

As this module only uses Perl's build in function, it relies on them to work
correctly. That means setting $GID and $EGID should also call setgroups(),
something that might not have been the case before Perl 5.004. So if you are 
running an older version, Proc::UID might be a better choice.

=head1 AUTHOR

Troels Liebe Bentsen <tlb@rapanden.dk> 

=head1 COPYRIGHT

Copyright(C) 2007-2009 Troels Liebe Bentsen

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
Privileges-Drop-1.03/t/000075500000000000000000000000001163671517300147235ustar00rootroot00000000000000Privileges-Drop-1.03/t/critic.t000064400000000000000000000003651163671517300163710ustar00rootroot00000000000000use strict;
use warnings;

use Test::More;

eval { 
    require Test::Perl::Critic;
    import  Test::Perl::Critic(-profile => 't/perlcriticrc');
};
plan skip_all => 'Test::Perl::Critic required to criticise code' if $@;

all_critic_ok('blib');
Privileges-Drop-1.03/t/dropuidgid.t000064400000000000000000000003541163671517300172440ustar00rootroot00000000000000use strict;
use warnings;

use Test::More tests => 1;                      # last test to print
use Privileges::Drop;

pass "No test written yet";

#system("id");
#drop_privileges('tlb');
#drop_uidgid(1000, 1000, 1001);
#system("id");

Privileges-Drop-1.03/t/perlcriticrc000064400000000000000000000000001163671517300173210ustar00rootroot00000000000000Privileges-Drop-1.03/t/pod-coverage.t000064400000000000000000000002411163671517300174600ustar00rootroot00000000000000use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
all_pod_coverage_ok();
Privileges-Drop-1.03/t/pod.t000064400000000000000000000002011163671517300156630ustar00rootroot00000000000000use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();