view release on metacpan or  search on metacpan

lib/Captive/Portal/Role/Utils.pm  view on Meta::CPAN

        $ip = $self->normalize_ip($ip);
        $arp_tbl->{$ip} = uc $mac;
    }

    my $mac = $arp_tbl->{$lookup_ip};

    return $mac if $mac;

    # nothing found
    DEBUG "can't find ip in ARPTABLE: '$lookup_ip'";

    return;
}

=item $capo->ip2hex($ip)

Helper method, convert ipv4 address to hexadecimal representation.

Example:
 '10.1.2.254' -> '0a0102fe'

=cut

sub ip2hex {
    my $self = shift;
    my $ip   = shift
      or LOGDIE 'missing param ip';

    return unpack( 'H8', pack( 'C4', split( /\./, $ip ) ) );
}

=item $capo->normalize_ip($ip)

Helper method, normalize ip adresses, strip leading zeros in octets.

Example:
 '012.2.3.000' -> '12.2.3.0'

=cut

sub normalize_ip {
    my $self = shift;

    my $ip = shift
      or LOGDIE "FATAL: missing param 'ip',";

    my @octets = split /\./, $ip;

    LOGDIE "FATAL: couldn't split '$ip' into 4 octets,"
      if scalar @octets != 4;

    # delete leading zeros in octets
    # (side effect: wrap octets 256 -> 0, ...), should not happen
    my $ip_packed_unpacked = join '.', unpack 'C4', pack 'C4', @octets;

    return $ip_packed_unpacked;
}

=item $capo->drop_privileges()

Running under root, like normal cronjobs do, should drop to the same uid/gid as the http daemon (and fcgi script). uid/gid is taken from config as RUN_USER/RUN_GROUP.

=cut

sub drop_privileges {
    my $self = shift;

    my $user = $self->cfg->{RUN_USER}
      or LOGDIE "FATAL: missing 'RUN_USER' in cfg file,";

    my $group = $self->cfg->{RUN_GROUP}
      or LOGDIE "FATAL: missing 'RUN_GROUP' in cfg file,";

    DEBUG "drop privileges to $user:$group";

    ########
    # resolve user to username and/or uid
    my ( $uname, $uid );

    if ( $user =~ m/^\d+$/ ) {
        $uname = getpwuid($user);
        $uid   = $user;
    }
    else {
        $uid   = getpwnam($user);
        $uname = $user;
    }

    unless ( defined($uname) and defined($uid) ) {
        LOGDIE "user '$user' not known to system\n";
    }

    ########
    # resolve group to groupname and/or gid
    my ( $gname, $gid );

    if ( $group =~ m/^\d+$/ ) {
        $gname = getgrgid($group);
        $gid   = $group;
    }
    else {
        $gid   = getgrnam($group);
        $gname = $group;
    }

    unless ( defined($gname) and defined($gid) ) {
        LOGDIE "group '$group' not known to system\n";
    }

    # switch to user:group not needed
    # already running under required uid:gid
    return if $> == $uid && $) == $gid;

    DEBUG "switch GID and EGID to $gid";

    $( = $) = $gid;
    LOGDIE "cannot change group to '$group': $!\n"
      if $) != $gid;

    DEBUG "switch UID and EUID to $uid";

    $< = $> = $uid;
    LOGDIE "cannot change user to '$user': $!\n"
      if $> != $uid;

}

=item $capo->spawn_cmd(@cmd_with_options, [$spawn_cmd_options])

Wrapper to run external commands, capture and return (stdout/stderr).

Last optional parameter item is a hashref with options for spawn_cmd itself:

    {
        timeout           => 2,    # default 2s
        ignore_exit_codes => [],   # exit codes without exception
    }

If the external command doesn't return after I<timeout>, the command is interrupted and an exception is thrown.

Exit codes != 0 and not defined in I<ignore_exit_codes> throw exceptions.

=cut

sub spawn_cmd {
    my $self = shift;
    my @argv = @_;
    LOGDIE "Paramter missing," unless scalar @argv;

    # defaults
    my $options = {
        timeout           => 2,    # at least 2s !
        ignore_exit_codes => [],
    };

    # options from caller override defaults
    if ( ref $argv[-1] eq 'HASH' ) {
        $options = { %$options, %{ pop @argv } };
    }

    my $results;

    DEBUG("try to spawn: @argv");
    {
        ####
        # get rid of some limitations with FCGI
        # ERROR: "Not a GLOB reference at .../FCGI.pm line 125"

        local *STDIN;
        local *STDOUT;
        local *STDERR;

        open( STDIN,  '<&=0' )  or die $!;
        open( STDOUT, '>>&=1' ) or die $!;
        open( STDERR, '>>&=2' ) or die $!;

        #
        $results = spawn_safe(