Commits

M6 KVM committed 16ae46b Draft

Upstream CPAN module Privileges-Drop-1.01 for package libprivileges-drop-perl

Comments (0)

Files changed (14)

+use 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 => {
+        'perl'    => '>= 5.8.0',
+        'Carp'    => 0,
+        'English' => 0,
+    },
+    build_requires => {
+        'Test::More' => 0,
+    },
+    add_to_cleanup => [ 
+        'Privileges-Drop-*',
+        'Makefile',
+        'blib',
+    ],
+);
+
+$builder->create_build_script();
+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
+Build.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
+with.pl
+---
+name: Privileges-Drop
+version: 1.01
+author:
+  - 'Troels Liebe Bentsen <troels@infopro.dk>'
+abstract: |-
+  A module to make it simple to drop all privileges, even 
+  POSIX groups.
+license: perl
+resources:
+  license: http://dev.perl.org/licenses/
+requires:
+  Carp: 0
+  English: 0
+  perl: '>= 5.8.0'
+build_requires:
+  Test::More: 0
+provides:
+  Privileges::Drop:
+    file: lib/Privileges/Drop.pm
+    version: 1.01
+generated_by: Module::Build version 0.280801
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.2.html
+  version: 1.2
+# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
+require >= 5.8.0;
+    
+    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);
+    require Module::Build;
+    Module::Build::Compat->write_makefile(build_class => 'Module::Build');
+NAME
+    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.
+
+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.
+
+#!/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");
+

lib/Privileges/Drop.pm

+package Privileges::Drop;
+use strict;
+use warnings;
+use English;
+use Carp;
+
+our $VERSION = '1.01';
+
+=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.
+
+
+=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));
+
+    # Drop privileges to $uid and $gid for both effective and save uid/gid
+    $GID = $EGID = $newgid;
+    $UID = $EUID = $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;
+use 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');
+use 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");
+

Empty file added.

+use 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();
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.