Privileges-Drop-1.03000755001750001750 011636072334 13202 5ustar00tlbtlb000000000000Privileges-Drop-1.03/MANIFEST.SKIP000444001750001750 113011636072334 15230 0ustar00tlbtlb000000000000# 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/README000444001750001750 375111636072334 14225 0ustar00tlbtlb000000000000NAME 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 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/Makefile.PL000444001750001750 226311636072334 15314 0ustar00tlbtlb000000000000# 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/ChangeLog000444001750001750 73611636072334 15077 0ustar00tlbtlb000000000000Version 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 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 for reporting this bug. Version 1.00 (Tue Sep 4 2007) * First version released Privileges-Drop-1.03/Build.PL000444001750001750 115111636072334 14631 0ustar00tlbtlb000000000000use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Privileges::Drop', license => 'perl', dist_author => 'Troels Liebe Bentsen ', 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/META.json000444001750001750 206111636072334 14757 0ustar00tlbtlb000000000000{ "abstract" : "A module to make it simple to drop all privileges, even \nPOSIX groups.", "author" : [ "Troels Liebe Bentsen " ], "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/MANIFEST000444001750001750 27211636072334 14451 0ustar00tlbtlb000000000000Build.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/META.yml000444001750001750 115711636072334 14614 0ustar00tlbtlb000000000000--- abstract: "A module to make it simple to drop all privileges, even \nPOSIX groups." author: - 'Troels Liebe Bentsen ' 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/lib000755001750001750 011636072334 13750 5ustar00tlbtlb000000000000Privileges-Drop-1.03/lib/Privileges000755001750001750 011636072334 16061 5ustar00tlbtlb000000000000Privileges-Drop-1.03/lib/Privileges/Drop.pm000444001750001750 1176611636072334 17513 0ustar00tlbtlb000000000000package 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 =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/examples000755001750001750 011636072334 15020 5ustar00tlbtlb000000000000Privileges-Drop-1.03/examples/drop.pl000555001750001750 51011636072334 16435 0ustar00tlbtlb000000000000#!/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/t000755001750001750 011636072334 13445 5ustar00tlbtlb000000000000Privileges-Drop-1.03/t/dropuidgid.t000444001750001750 35411636072334 16103 0ustar00tlbtlb000000000000use 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/perlcriticrc000444001750001750 011636072334 16120 0ustar00tlbtlb000000000000Privileges-Drop-1.03/t/pod-coverage.t000444001750001750 24111636072334 16317 0ustar00tlbtlb000000000000use 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/critic.t000444001750001750 36511636072334 15230 0ustar00tlbtlb000000000000use 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/pod.t000444001750001750 20111636072334 14522 0ustar00tlbtlb000000000000use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok();