view release on metacpan or  search on metacpan

VBTK/PHttpd.pm  view on Meta::CPAN

#        STDOUT->close();
#        exit 0;
#    }
#    else
#    {
#        error("genPodHtml: Can't fork");
#    }
#
#    # Run the command;
#    $pid = open2($rdrfh,$wtrfh,$target);
#
#    # If there's no PID, then just return
#    unless($pid)
#    {
#        $conn->send_error(RC_INTERNAL_SERVER_ERROR);
#        $rdrfh->close;
#        $wtrfh->close;
#        return -1;
#    }
#
#    # Write out all the passed parameters to the CGI
#    foreach $key (keys %{$parms})
#    {
#        print $wtrfh "$key=$parms->{$key}\n";
#    }
#    $wtrfh->close;
#
#    # Read all the output    
#    my @output = <$rdrfh>;
#
#    # Define a response object
#    my $response = new HTTP::Response;
#
#    # Step through the headers
#    for(;;)
#    {
#        $str = unshift(@output);
#        last if ($str =~ /^\s*$/);
#
#        if($str =~ /ContentType/) { $response->type($1); }
#    }
#
#    my $html = join('',@output);
#
#    if(defined $html)
#    {
#        $response->content($html);
#
#        $conn->send_response($response);
#    }
#    else
#    {
#        $conn->send_error(RC_INTERNAL_SERVER_ERROR);
#    }
#
#    (0);
#}

#-------------------------------------------------------------------------------
# Function:     unixAuthWGroup
# Description:  Check the passed userid and password using the getpwuid function.
#               If they authenticate, then check to see if the user is in one of
#               the specified groups.
# Input Parms:  Userid, Password, Group List (space or comma delimited)
# Output Parms: True | False
#-------------------------------------------------------------------------------
sub unixAuthWGroup
{
    my ($userId,$passwd,$groupList) = @_;

    &unixAuth($userId,$passwd) && &inGroup($userId,$groupList);
}

#-------------------------------------------------------------------------------
# Function:     unixAuth
# Description:  Check the passed userid and password using the getpwuid function
# Input Parms:  Userid, Password
# Output Parms: True | False
#-------------------------------------------------------------------------------
sub unixAuth
{
    my ($userId,$passwd) = @_;

    my $pwd = (getpwnam($userId))[1];

    if (! defined $pwd)
    {
        &log("Invalid user '$userId'");
        (0);
    }
    elsif (crypt($passwd, $pwd) ne $pwd) 
    {
        &log("User '$userId' failed authorization");
        (0);
    } 
    else 
    {
        &log("User '$userId' passed authorization") if ($VERBOSE);
        (1);
    }
}

#-------------------------------------------------------------------------------
# Function:     inGroup
# Description:  See if the passed userid is in the specified group.
# Input Parms:  Userid, Group
# Output Parms: True | False
#-------------------------------------------------------------------------------
sub inGroup
{
    my($userId,$groupList) = @_;
    my($str,$group,$gid,$userList);

    # Load up the list of allowed groups.
    my(@allowedGroupList) = split(/[\s,:]+/,$groupList);

    foreach $group (@allowedGroupList)
    {
        my $memberStr = (getgrnam($group))[3];

        if ($memberStr =~ /\b$userId\b/)
        {
            &log("User '$userId' is in group '$group'") if ($VERBOSE > 1);
            return 1;
        }
    }

    &log("User '$userId' is not in group '$groupList'") if ($VERBOSE);

    (0);    
}

#-------------------------------------------------------------------------------
# Function:     reaper
# Description:  Look for dead child processes and reap them
# Input Parms:  None