view release on metacpan or search on metacpan
lib/AnyEvent/PgRecvlogical.pm view on Meta::CPAN
$recv->start;
=head1 DESCRIPTION
C<AnyEvent::PgRecvlogical> provides perl bindings of similar functionality to that of
L<pg_recvlogical|https://www.postgresql.org/docs/current/static/app-pgrecvlogical.html>.
The reasoning being that C<pg_recvlogical> does afford the consuming process the opportunity to emit feedback to
PostgreSQL. This results is potentially being sent more data than you can handle in a timely fashion.
=cut
view release on metacpan or search on metacpan
lib/AnyEvent/Ping.pm view on Meta::CPAN
=head3 C<timeout>
=head3 C<on_prepare>
In some cases you need to "tune" the socket before it is used to ping (for
exmaple, to bind it on a given IP address).
my $ping = AnyEvent::Ping->new(
on_prepare => sub {
my $socket = shift;
...
view release on metacpan or search on metacpan
lib/AnyEvent/RabbitMQ/Fork/Channel.pm view on Meta::CPAN
my @methods = qw(
open
close
declare_exchange
bind_exchange
unbind_exchange
delete_exchange
declare_queue
bind_queue
unbind_queue
purge_queue
delete_queue
publish
consume
cancel
view release on metacpan or search on metacpan
lib/AnyEvent/RabbitMQ/PubSub.pm view on Meta::CPAN
channel => $channel,
exchange => $exchange,
queue => $queue,
routing_key => $routing_key,
);
$consumer->init(); #declares channel, queue and binding
$consumer->consume(
$cv,
sub {
my ($consumer, $msg) = @_;
print 'received ', $msg->{body}->payload, "\n";
view release on metacpan or search on metacpan
example/synopsis.pl view on Meta::CPAN
durable => 0,
auto_delete => 1,
},
],
# exchange to exchange bindings, with optional routing key
bind_exchanges => [
{ 'stats' => 'logger' },
{ 'errors' => [ 'logger', '*.error.#' ] },
{ 'info' => [ 'logger', '*.info.#' ] },
],
# queue to exchange bindings, with optional routing key
bind_queues => [
{ 'debug-queue' => 'logger' },
{ 'ftp-error-logs' => [ 'errors', 'ftp.error.#' ] },
{ 'mail-error-logs' => [ 'errors', 'mail.error.#' ] },
{ 'info-logs' => [ 'info', 'info.#' ] },
{ 'stats-logs' => [ 'stats', 'mail.stats' ] },
view release on metacpan or search on metacpan
lib/AnyEvent/RabbitMQ.pm view on Meta::CPAN
product => __PACKAGE__,
information => 'http://d.hatena.ne.jp/cooldaemon/',
version => Net::AMQP::Value::String->new(__PACKAGE__->VERSION),
capabilities => {
consumer_cancel_notify => Net::AMQP::Value::true,
exchange_exchange_bindings => Net::AMQP::Value::true,
},
%{ $args{client_properties} || {} },
},
mechanism => 'AMQPLAIN',
response => {
lib/AnyEvent/RabbitMQ.pm view on Meta::CPAN
AnyEvent::RabbitMQ is an AMQP(Advanced Message Queuing Protocol) client library, that is intended to allow you to interact with AMQP-compliant message brokers/servers such as RabbitMQ in an asynchronous fashion.
You can use AnyEvent::RabbitMQ to -
* Declare and delete exchanges
* Declare, delete, bind and unbind queues
* Set QoS and confirm mode
* Publish, consume, get, ack, recover and reject messages
* Select, commit and rollback transactions
Most of these actions can be done through L<AnyEvent::RabbitMQ::Channel>.
view release on metacpan or search on metacpan
lib/AnyEvent/Radius/Client.pm view on Meta::CPAN
# port
# secret
# dictionary
# read_timeout
# write_timeout
# bind_ip
# initial_last_request_id - random by default
#- callbacks:
# on_read
# on_read_raw
# on_read_timeout
lib/AnyEvent/Radius/Client.pm view on Meta::CPAN
wtimeout => $h{write_timeout} // WRITE_TIMEOUT_SEC,
);
die "No IP argument" if ! exists $h{ip};
$udp_handle_args{connect} = [ $h{ip}, $h{port} // RADIUS_PORT ];
$udp_handle_args{bind} = [$h{bind_ip}, 0] if exists $h{bind_ip};
$udp_handle_args{on_recv} = sub {
my ($data, $handle, $from) = @_;
$obj->read_cv->end;
$obj->reply_cnt($obj->reply_cnt + 1);
lib/AnyEvent/Radius/Client.pm view on Meta::CPAN
=item secret - RADIUS secret string for remote server
=item dictionary - optional, dictionary loaded by L<load_dictionary()> method
=item bind_ip - optional, the local ip address to bind client to
=item read_timeout
=item write_timeout - network I/O timeouts (default is 5 second)
view release on metacpan or search on metacpan
=item unexpected disk I/O
By default, readline does filename completion on TAB, and reads its
config files.
Tab completion can be disabled by calling C<< $rl->unbind_key (9) >>.
=item tty settings
After readline has been initialised, it will mangle the termios tty
settings. This does not normally affect output very much, but should be
view release on metacpan or search on metacpan
t/tlib/Test/RedisRunner.pm view on Meta::CPAN
sub connect_info {
my $self = shift;
my $conf = $self->{conf};
my $host = $conf->{bind} || '0.0.0.0';
my $port = $conf->{port};
if ( !$port || $port == 0 ) {
$host = 'unix/';
$port = $conf->{unixsocket};
view release on metacpan or search on metacpan
t/redis.conf.base view on Meta::CPAN
pidfile /var/run/redis.pid
# Accept connections on the specified port, default is 6379
port __PORT__
# If you want you can bind a single interface, if the bind option is not
# specified all the interfaces will listen for connections.
#
# bind 127.0.0.1
# Close the connection after a client is idle for N seconds (0 to disable)
timeout 300
# Save the DB on disk:
view release on metacpan or search on metacpan
t/tlib/Test/RedisRunner.pm view on Meta::CPAN
sub connect_info {
my $self = shift;
my $conf = $self->{conf};
my $host = $conf->{bind} || '0.0.0.0';
my $port = $conf->{port};
if ( !$port || $port == 0 ) {
$host = 'unix/';
$port = $conf->{unixsocket};
view release on metacpan or search on metacpan
lib/AnyEvent/SNMP/TrapReceiver.pm view on Meta::CPAN
ent_oid OBJECT IDENTIFIER,
agent_addr IPAddress,
generic_trap INTEGER,
specific_trap INTEGER,
timeticks TimeTicks,
varbindlist VARBINDS
}
PDUv2 ::= SEQUENCE {
request_id INTEGER,
error_status INTEGER,
error_index INTEGER,
varbindlist VARBINDS
}
VARBINDS ::= SEQUENCE OF SEQUENCE {
oid OBJECT IDENTIFIER,
value CHOICE {
integer INTEGER,
lib/AnyEvent/SNMP/TrapReceiver.pm view on Meta::CPAN
sub new {
my ( $class, %args ) = @_;
my $self = bless { cb => $args{cb} || croak('cb not given'), }, $class;
my $bindTo;
if ( exists $args{bind} ) {
$bindTo = $args{bind};
} else {
$bindTo = [ '0.0.0.0', SNMPTRAPD_DEFAULT_PORT ],;
}
$self->{server} = AnyEvent::Handle::UDP->new(
bind => $bindTo,
on_recv => sub {
my $trap = _handle_trap(@_);
$self->format($trap);
lib/AnyEvent/SNMP/TrapReceiver.pm view on Meta::CPAN
int( ( $timeticks % 6000 ) / 100 ), # seconds
);
$trap->{uptime} = \@uptime;
} ## end if ( exists $trap->{timeticks...})
# convert varbindlist to key->value
foreach my $var ( @{ $trap->{varbindlist} } ) {
my $oid = $var->{oid};
my $value = $var->{value};
$trap->{oid}{$oid} = ( values( %{$value} ) )[0];
}
delete $trap->{varbindlist};
return $trap;
} ## end sub format
1;
lib/AnyEvent/SNMP/TrapReceiver.pm view on Meta::CPAN
use AnyEvent::SNMP::TrapReceiver;
my $cond = AnyEvent->condvar;
my $echo_server = AnyEvent::SNMP::TrapReceiver->new(
bind => ['0.0.0.0', 162],
cb => sub {
my ( $trap) = @_;
},
);
lib/AnyEvent/SNMP/TrapReceiver.pm view on Meta::CPAN
The trap decoder code was copied from Net::SNMPTrapd by Michael Vincent.
=head1 ATTRIBUTES
=head2 bind
The IP address and port to bind the UDP listener/handle.
=head2 cb
The codeblock to be called when a trap is received.
view release on metacpan or search on metacpan
lib/AnyEvent/SOCKS/Client.pm view on Meta::CPAN
}
sub connect_cmd_finalize{
my( $self, $type ) = @_ ;
AE::log "debug" => "Connect cmd done, bind atype is $type";
if($type == TYPE_IP4){
$self->{hd}->push_read( chunk => 6, sub{
my( $host, $port) = unpack( "a4n", $_[1] );
$self->socks_connect_done( format_ipv4( $host ), $port );
lib/AnyEvent/SOCKS/Client.pm view on Meta::CPAN
AE::log "error" => "Unknown atype $type";
}
}
sub socks_connect_done{
my( $self, $bind_host, $bind_port ) = @_;
my $that = shift @{ $self->{chain} }; # shift = move forward in chain
AE::log "debug" => "Done with server socks$that->{v}://$that->{host}:$that->{port} , bound to $bind_host:$bind_port";
if( @{ $self->{chain} } ){
$self->handshake ;
return ;
}
view release on metacpan or search on metacpan
lib/AnyEvent/Sway.pm view on Meta::CPAN
workspace => ($event_mask | 0),
output => ($event_mask | 1),
mode => ($event_mask | 2),
window => ($event_mask | 3),
barconfig_update => ($event_mask | 4),
binding => ($event_mask | 5),
shutdown => ($event_mask | 6),
tick => ($event_mask | 7),
_error => 0xFFFFFFFF,
);
view release on metacpan or search on metacpan
t/02input.t view on Meta::CPAN
'on_mouse press(1) @20,10' );
}
{
my $got_Ctrl_A;
$tickit->bind_key( "C-a" => sub { $got_Ctrl_A++ } );
$my_wr->syswrite( "\cA" );
do { AnyEvent->_poll } until ( $got_Ctrl_A );
is( $got_Ctrl_A, 1, 'bind Ctrl-A' );
}
done_testing;
view release on metacpan or search on metacpan
lib/AnyEvent/Whois/Raw.pm view on Meta::CPAN
}
my $rotate_reference = eval { Net::Whois::Raw::get_ips_for_query($srv) };
if (!$rotate_reference && @Net::Whois::Raw::SRC_IPS && $sockname eq getsockname($fh)) {
# we have ip and there was no bind request in on_prepare callback
$rotate_reference = \@Net::Whois::Raw::SRC_IPS;
}
if ($rotate_reference) {
my $ip = shift @$rotate_reference;
bind $fh, AnyEvent::Socket::pack_sockaddr(0, parse_address($ip));
push @$rotate_reference, $ip; # rotate ips
}
return exists $stash->{params}{timeout} ?
$stash->{params}{timeout} :
lib/AnyEvent/Whois/Raw.pm view on Meta::CPAN
Timeout for whois request in seconds
=item on_prepare => $cb
Same as prepare callback from AnyEvent::Socket. So you can bind socket to some ip:
whois 'google.com', on_prepare => sub {
bind $_[0], AnyEvent::Socket::pack_sockaddr(0, AnyEvent::Socket::parse_ipv4($ip)));
}, sub {
my $info = shift;
}
=back
view release on metacpan or search on metacpan
lib/AnyEvent/XMPP.pm view on Meta::CPAN
This is the head module of the L<AnyEvent::XMPP> XMPP client protocol (as described in
RFC 3920 and RFC 3921) framework.
L<AnyEvent::XMPP::Connection> is a RFC 3920 conforming "XML" stream implementation
for clients, which handles TCP connect up to the resource binding. And provides
low level access to the XML nodes on the XML stream along with some high
level methods to send the predefined XML stanzas.
L<AnyEvent::XMPP::IM::Connection> is a more high level module, which is derived
from L<AnyEvent::XMPP::Connection>. It handles all the instant messaging client
view release on metacpan or search on metacpan
backup_one_LB|||
backup_one_SB|||
backup_one_WB|||
bad_type_gv|||
bad_type_pv|||
bind_match|||
block_end||5.004000|
block_gimme||5.004000|
block_start||5.004000|
blockhook_register||5.013003|
boolSV|5.004000||p
view release on metacpan or search on metacpan
lib/AnyEvent/YACurl.pm view on Meta::CPAN
1;
=head1 NAME
AnyEvent::YACurl - Yet Another curl binding for AnyEvent
=head1 SYNOPSIS
use AnyEvent;
use AnyEvent::YACurl ':constants';
lib/AnyEvent/YACurl.pm view on Meta::CPAN
my $response_code = $response->getinfo(CURLINFO_RESPONSE_CODE);
print "Have response code $response_code. Body was $return_data";
=head1 DESCRIPTION
This module provides bindings to curl, integrated into AnyEvent.
=head1 METHODS
=head2 AnyEvent::YACurl
=over
=item C<new>
Returns a new C<AnyEvent::YACurl> object. This is essentially a binding over curl's
L<"multi" interface|https://curl.haxx.se/libcurl/c/libcurl-multi.html>.
Its first and only argument is a required hashref containing options to control behavior, such as
C<CURLMOPT_MAX_TOTAL_CONNECTIONS>. Refer to the actual
L<curl documentation|https://curl.haxx.se/libcurl/c/curl_multi_setopt.html> to find out about
view release on metacpan or search on metacpan
lib/AnyEvent/ZeroMQ/Handle.pm view on Meta::CPAN
use namespace::autoclean;
has 'socket' => (
is => 'ro',
isa => 'ZeroMQ::Raw::Socket',
handles => [qw/bind connect/],
required => 1,
);
before qw/bind connect/ => sub {
$_[0]->identity;
};
after qw/bind connect/ => sub {
my $self = shift;
# this can change readability/writability status, so do the checks
# again
$self->read;
$self->write;
};
has 'identity' => (
is => 'rw', # note: you can change this, but it has
# no effect until a new bind/connect.
isa => IdentityStr,
lazy_build => 1,
trigger => sub { shift->_change_identity(@_) },
);
view release on metacpan or search on metacpan
lib/AnyEvent/mDNS.pm view on Meta::CPAN
my $data = AnyEvent::DNS::dns_pack { rd => 1, qd => [[$fqdn, "ptr"]] };
my($name, $alias, $udp_proto) = AnyEvent::Socket::getprotobyname('udp');
socket my($sock), PF_INET, SOCK_DGRAM, $udp_proto;
AnyEvent::Util::fh_nonblocking $sock, 1;
bind $sock, sockaddr_in(0, Socket::inet_aton('0.0.0.0'))
or ($args{on_error} || sub { die @_ })->($!);
my %found;
my $callback = $args{on_found} || sub {};
view release on metacpan or search on metacpan
lib/AnyMQ/AMQP.pm view on Meta::CPAN
=for stopwords
=head1 NAME
AnyMQ::AMQP - AMQP binding for AnyMQ
=head1 SYNOPSIS
use AnyMQ;
my $bus = AnyMQ->new_with_traits(traits => ['AMQP'],
view release on metacpan or search on metacpan
lib/AnyMQ.pm view on Meta::CPAN
use AnyMQ;
my $mq = AnyMQ->topic('Foo'); # gets an AnyMQ::Topic object
$mq->publish({ message => 'Hello world'});
# bind to external message queue servers using traits.
# my $bus = AnyMQ->new_with_traits(traits => ['AMQP'],
# host => 'localhost',
# port => 5672,
# user => 'guest',
# pass => 'guest',
view release on metacpan or search on metacpan
mongo_support.c view on Meta::CPAN
buf->pos[i] = digit1*16+digit2;
}
buf->pos += OID_SIZE;
}
void perl_mongo_serialize_bindata(buffer *buf, SV *sv)
{
STRLEN len;
const char *bytes = SvPVbyte (sv, len);
// length of length+bindata
perl_mongo_serialize_int(buf, len+4);
// TODO: type
perl_mongo_serialize_byte(buf, 2);
// length
perl_mongo_serialize_int(buf, len);
// bindata
perl_mongo_serialize_bytes(buf, bytes, len);
}
void perl_mongo_serialize_key(buffer *buf, const char *str, int is_insert) {
SV *c = get_sv("AnyMongo::BSON::char", 0);
mongo_support.c view on Meta::CPAN
}
else {
/* binary */
set_type(buf, BSON_BINARY);
perl_mongo_serialize_key(buf, key, is_insert);
perl_mongo_serialize_bindata(buf, SvRV(sv));
}
}
} else {
switch (SvTYPE (SvRV (sv))) {
case SVt_PVHV:
mongo_support.c view on Meta::CPAN
break;
case SVt_PV:
/* binary */
set_type(buf, BSON_BINARY);
perl_mongo_serialize_key(buf, key, is_insert);
perl_mongo_serialize_bindata(buf, SvRV(sv));
break;
default:
sv_dump(SvRV(sv));
croak ("type (ref) unhandled");
}
mongo_support.c view on Meta::CPAN
/* string */
case SVt_PV:
if (sv_len (sv) != strlen (SvPV_nolen (sv))) {
set_type(buf, BSON_BINARY);
perl_mongo_serialize_key(buf, key, is_insert);
perl_mongo_serialize_bindata(buf, sv);
}
else {
STRLEN len;
const char *str = SvPV(sv, len);
view release on metacpan or search on metacpan
# better error checking ?
$filename ||= $r->filename();
# using _ is optimized to use last stat() record
return(404) if (! -e $filename or -d _);
# alias $0 to filename, bind to glob for bug workaround
local *0 = \$filename;
# ASP object creation, a lot goes on in there!
# method call used for speed optimization, as OO calls are slow
my $self = &Apache::ASP::new('Apache::ASP', $r, $filename);
view release on metacpan or search on metacpan
t/httpd.conf-dist view on Meta::CPAN
# would only count as 1 request towards this limit.
#
MaxRequestsPerChild 0
#
# Listen: Allows you to bind Apache to specific IP addresses and/or
# ports, in addition to the default. See also the <VirtualHost>
# directive.
#
#Listen 3000
#Listen 12.34.56.78:80
view release on metacpan or search on metacpan
Mercury/DBI.pm view on Meta::CPAN
Apache::App::Mercury::Config::DBI_PASS,
{'RaiseError' => 1});
my $sth = $dbh->prepare_cached
("SELECT count(*) FROM ".Apache::App::Mercury::Config::DBI_SQL_MSG_TABLE()." WHERE recipient=? AND status=? AND recipient!=sender");
$sth->execute($user, 'unread');
$sth->bind_col(1, \$unread);
$sth->fetchrow_arrayref;
$sth->finish;
$dbh->disconnect;
};
if ($@) {
Mercury/DBI.pm view on Meta::CPAN
} elsif (!grep($new_status, ('unread','read','replied','forwarded','deleted'))) {
$self->log_error("->change_status: new_status must be one of 'unread','read','replied','forwarded','deleted' - not $new_status");
return 0;
}
my ($where_clause, @bind_params);
if ($all_in_this_box) {
$where_clause = "WHERE box=?";
push(@bind_params, $all_in_this_box);
} else {
my $placeholders = join(", ", map {'?'} @ids);
$where_clause = "WHERE id IN($placeholders)";
@bind_params = @ids;
}
eval {
my $dbh = DBI->connect
(Apache::App::Mercury::Config::DBI_CONNECT_STR,
Apache::App::Mercury::Config::DBI_LOGIN,
Apache::App::Mercury::Config::DBI_PASS,
{'RaiseError' => 1});
# mark message(s) as $new_status
my $sth = $dbh->prepare_cached
("UPDATE ".Apache::App::Mercury::Config::DBI_SQL_MSG_TABLE()." SET $status_col=?,timestamp=timestamp $where_clause");
$sth->execute($new_status, @bind_params);
$sth->finish;
$dbh->disconnect;
};
if ($@) {
$self->log_error;
Mercury/DBI.pm view on Meta::CPAN
if (!$to_box and !(@ids and $all_in_this_box)) {
$self->log_error("->change_box: must specify new mailbox and msg id or box to move all from!");
return 0;
}
my ($where_clause, @bind_params);
if ($all_in_this_box) {
$where_clause = "WHERE box=?";
push(@bind_params, $all_in_this_box);
} else {
my $placeholders = join(", ", map {'?'} @ids);
$where_clause = "WHERE id IN($placeholders)";
@bind_params = @ids;
}
eval {
my $dbh = DBI->connect
(Apache::App::Mercury::Config::DBI_CONNECT_STR,
Apache::App::Mercury::Config::DBI_LOGIN,
Apache::App::Mercury::Config::DBI_PASS,
{'RaiseError' => 1});
my $sth = $dbh->prepare_cached
("UPDATE ".Apache::App::Mercury::Config::DBI_SQL_MSG_TABLE()." SET box=?,timestamp=timestamp $where_clause");
$sth->execute($to_box, @bind_params);
$sth->finish;
$dbh->disconnect;
};
if ($@) {
$self->log_error;
Mercury/DBI.pm view on Meta::CPAN
my $sort_direction = (($box and $self->{$box}->{'sortdir'} and
$self->{$box}->{'sortdir'} eq 'up')
? 'ASC' : 'DESC');
my ($where_clause, @bind_params);
if ($box) {
$where_clause = ($box eq 'outbox'
? "WHERE sender=? AND status_sender!='deleted'"
: "WHERE recipient=? AND status!='deleted'");
push(@bind_params, $user);
if ($box eq 'inbox') {
$where_clause .= " AND (box='' OR box='inbox')";
} elsif ($box ne 'outbox') {
$where_clause .= " AND box=?";
push(@bind_params, $box);
}
$self->{$box}->{'index'} = [];
} elsif ($smtp_status) {
$where_clause = "WHERE status_smtp=?";
push(@bind_params, $smtp_status);
} else {
if (ref $ids eq 'ARRAY') {
my $placeholders = join(", ", map {'?'} @$ids);
$where_clause = "WHERE id IN($placeholders)";
@bind_params = @$ids;
}
if ($trans_code) {
$where_clause .=
($where_clause ? " AND" : "WHERE")." code=? AND trans=?";
push(@bind_params, $trans_code, 'show');
}
}
eval {
my $dbh = DBI->connect
Mercury/DBI.pm view on Meta::CPAN
Apache::App::Mercury::Config::DBI_LOGIN,
Apache::App::Mercury::Config::DBI_PASS,
{'RaiseError' => 1});
my $sth = $dbh->prepare_cached
("SELECT id,recipient,sent_to,sender,timestamp,DATE_FORMAT(timestamp, '%a %b %d %r %Y'),subject,body,attachments,status,status_smtp,code,trans,security,box FROM ".Apache::App::Mercury::Config::DBI_SQL_MSG_TABLE()." $where_clause ORDER BY $sorter...
$sth->execute(@bind_params);
my ($id, $recip, $sent_to, $sender, $timestamp, $time_recvd, $subj,
$body, $attach, $status, $smtp_status, $code, $display_trans,
$security, $thebox);
$sth->bind_columns
(\ ($id, $recip, $sent_to, $sender, $timestamp, $time_recvd, $subj,
$body, $attach, $status, $smtp_status, $code, $display_trans,
$security, $thebox) );
while ($sth->fetchrow_arrayref) {
$msgs{$id} = Apache::App::Mercury::Message->new
view release on metacpan or search on metacpan
lib/Apache/AuthCAS.pm view on Meta::CPAN
return ();
}
my $sth = $dbh->prepare("SELECT last_accessed, uid, pgtiou FROM $DB_SESSION_TABLE WHERE id=?;");
$sth->execute($sid);
my ($last_accessed, $uid, $pgtiou);
$sth->bind_columns(\$last_accessed, \$uid, \$pgtiou);
my $result = $sth->fetch();
$sth->finish();
$dbh->disconnect();
if ($result) {
lib/Apache/AuthCAS.pm view on Meta::CPAN
return "";
}
my $sth = $dbh->prepare("SELECT pgt FROM $DB_PGTIOU_TABLE WHERE pgtiou=?;");
$sth->execute($pgtiou);
my $pgt;
$sth->bind_col(1, \$pgt);
my $result = $sth->fetch();
$sth->finish();
$dbh->disconnect();
if ($result) {
view release on metacpan or search on metacpan
AuthCookieLDAP.pm view on Meta::CPAN
}
# Bind annonymously
my $mess = $con->bind();
unless ($mess->code == LDAP_SUCCESS) {
$r->log_reason("LDAP Bind Failed", $r->uri);
return 'bad';
}
AuthCookieLDAP.pm view on Meta::CPAN
# Take the first user
my $entry = $mess->first_entry;
my $dn = $entry->dn;
# Bind as the user we're authenticating
$mess = $con->bind($dn, password => $password);
unless ($mess->code == LDAP_SUCCESS) {
$r->log_reason("User $user har wrong password", $r->uri);
return 'bad';
}
$con->unbind;
# Create the expire time for the ticket.
my $expire_time;
view release on metacpan or search on metacpan
AuthLDAP.pm view on Meta::CPAN
$r->note_basic_auth_failure;
$r->log_reason("user $name: LDAP Connection Failed",$r->uri);
return AUTH_REQUIRED;
}
if ($ld->bind_s != LDAP_SUCCESS)
{
$r->note_basic_auth_failure;
$r->log_reason("user $name: LDAP Initial Bind Failed",$r->uri);
return AUTH_REQUIRED;
}
AuthLDAP.pm view on Meta::CPAN
my $status = $ld->search_s($basedn,LDAP_SCOPE_SUBTREE,$filter,["c"],1);
if ($status != LDAP_SUCCESS)
{
$r->note_basic_auth_failure;
$r->log_reason("user $name: ldap search failed",$r->uri);
$ld->unbind;
return AUTH_REQUIRED;
}
if ($ld->count_entries != 1)
{
$r->note_basic_auth_failure;
$r->log_reason("user $name: username not found",$r->uri);
$ld->unbind;
return AUTH_REQUIRED;
}
$ld->first_entry;
my $dn = $ld->get_dn;
$status = $ld->bind_s($dn,$sent_pwd);
if ($status == LDAP_SUCCESS)
{
$r->push_handlers(PerlAuthzHandler => \&authz);
$ld->unbind;
return OK;
}
$ld->unbind;
$r->note_basic_auth_failure;
$r->log_reason("user $name: password mismatch", $r->uri);
return AUTH_REQUIRED;
}
AuthLDAP.pm view on Meta::CPAN
} elsif ($require eq "valid-user")
{
return OK;
} else {
my $ld = new Net::LDAPapi($ldapserver,$ldapport);
$ld->bind_s;
my $filter = "(&(|($require=" . join(")($require=",@rest) .
"))($uidattr=$name))";
my $status = $ld->search_s($basedn,LDAP_SCOPE_SUBTREE,$filter,["c"],1);
if ($status != LDAP_SUCCESS)
{
$r->note_basic_auth_failure;
$r->log_reason("LDAP Lookup Failed",$r->uri);
$ld->unbind;
return AUTH_REQUIRED;
}
if ($ld->count_entries == 1)
{
$ld->unbind;
return OK;
}
$ld->unbind;
}
}
$r->note_basic_auth_failure;
$r->log_reason("user $name: not authorized", $r->uri);