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;