Result:
found more than 440 distributions - search limited to the first 2001 files matching your query
( run in 0.959 )
AnyEvent-RabbitMQ-Fork
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
AnyEvent-RabbitMQ-PubSub
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";
AnyEvent-RabbitMQ-Simple
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' ] },
AnyEvent-RabbitMQ
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>.
AnyEvent-Radius
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)
AnyEvent-ReadLine-Gnu
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
AnyEvent-Redis-RipeRedis
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};
AnyEvent-Redis
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:
AnyEvent-RipeRedis
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};
AnyEvent-SNMP-TrapReceiver
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.
AnyEvent-SOCKS-Client
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 ;
}
AnyEvent-Sway
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,
);
AnyEvent-Tickit
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;
AnyEvent-Whois-Raw
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
AnyEvent-XMPP
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
AnyEvent-XSPromises
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
AnyEvent-YACurl
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
AnyEvent-ZeroMQ
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(@_) },
);
AnyEvent-mDNS
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 {};
AnyMQ-AMQP
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'],
AnyMQ
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',
AnyMongo
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);
Apache-ASP
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);
Apache-Admin-Config
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
Apache-App-Mercury
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
Apache-AuthCAS
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) {
Apache-AuthCookieLDAP
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;
Apache-AuthLDAP
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);
Apache-AuthLDAPBind
view release on metacpan or search on metacpan
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
use strict;
use Net::LDAP;
use Apache::Constants qw(:common);
=head1 NAME
Apache::AuthLDAPBind - Authentcates a user to Apache by binding to an
LDAP server as that user.
=head1 VERSION
Version 0.02
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
our $VERSION = '0.02';
=head1 SYNOPSIS
This is an authentication module for Apache 1.3 (and mod_perl) that
authenticates a user to an LDAP server by binding as that user (with
his supplied password). If the bind succeeds, the user is
authenticated. If not, authentication fails.
This is much more secure than the usual method of checking the
password against a hash, since there's no possibility that the hash
will be viewed while in transit (or worse, simply pulled out of the
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
return AUTH_REQUIRED;
}
my $ok;
eval {
$ok = _bind_ldap($ldap_server, $ldap_port, $base_dn, $uid_attr,
$username, $sent_password);
};
$ok = 0 if $@;
if(!$ok){
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
return ($ldap_server, $ldap_port, $base_dn, $uid_attr);
}
# returns false if login fails, true if login succeeds. dies on errors.
sub _bind_ldap {
my $ldap_server = shift;
my $ldap_port = shift;
my $base_dn = shift;
my $uid_attr = shift;
my $username = shift;
my $password = shift;
# prevent anonymous binds!
if(!defined $username || !defined $password){
die "null username/password passed to _bind_ldap!";
}
my $ldap = Net::LDAP->new("$ldap_server".
((defined $ldap_port) ? ":$ldap_port" : ""));
my $mesg = $ldap->start_tls();
$mesg = $ldap->bind("$uid_attr=$username,$base_dn",
password=>$password);
$ldap->unbind; # take down session
$mesg->code && return 0; # failed
return 1; # passed
}
lib/Apache/AuthLDAPBind.pm view on Meta::CPAN
Jonathan T. Rockway, C<< <jon-cpan@jrock.us> >>
=head1 BUGS
Please report any bugs or feature requests to
C<bug-apache-authldapbind@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Apache-AuthLDAPBind>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 COPYRIGHT & LICENSE
Apache-AuthNetLDAP
view release on metacpan or search on metacpan
AuthNetLDAP.pm view on Meta::CPAN
return $result if $result;
# change based on version of mod_perl
my $user = MP2 ? $r->user : $r->connection->user;
my $binddn = $r->dir_config('BindDN') || "";
my $bindpwd = $r->dir_config('BindPWD') || "";
my $basedn = $r->dir_config('BaseDN') || "";
my $ldapserver = $r->dir_config('LDAPServer') || "localhost";
my $ldapport = $r->dir_config('LDAPPort') || 389;
my $uidattr = $r->dir_config('UIDAttr') || "uid";
my $allowaltauth = $r->dir_config('AllowAlternateAuth') || "no";
AuthNetLDAP.pm view on Meta::CPAN
or MP2 ? $r->log_error( "Unable to start_tls", $r->uri)
: $r->log_reason("Unable to start_tls", $r->uri);
}
my $mesg;
#initial bind as user in Apache config
if ($bindpwd ne "")
{
$mesg = $ldap->bind($binddn, password=>$bindpwd);
}
else
{
$mesg = $ldap->bind();
}
#each error message has an LDAP error code
if (my $error = $mesg->code())
{
AuthNetLDAP.pm view on Meta::CPAN
}
}
}
else
{
$mesg = $ldap->bind($entry->dn(),password=>$password);
}
if (my $error = $mesg->code())
{
$r->note_basic_auth_failure;
MP2 ? $r->log_error("user $user: failed bind: $error",$r->uri) : $r->log_reason("user $user: failed bind: $error",$r->uri);
return MP2 ? Apache::HTTP_UNAUTHORIZED : Apache::Constants::HTTP_UNAUTHORIZED;
}
my $error = $mesg->code();
my $dn = $entry->dn();
# MP2 ? $r->log_error("AUTHDEBUG user $dn:$password bind: $error",$r->uri) : $r->log_reason("AUTHDEBUG user $dn:$password bind: $error",$r->uri);
return MP2 ? Apache::OK : Apache::Constants::OK;
}
# Autoload methods go after =cut, and are processed by the autosplit program.
AuthNetLDAP.pm view on Meta::CPAN
=head1 SYNOPSIS
AuthName "LDAP Test Auth"
AuthType Basic
#only set the next two if you need to bind as a user for searching
#PerlSetVar BindDN "uid=user1,ou=people,o=acme.com" #optional
#PerlSetVar BindPWD "password" #optional
PerlSetVar BaseDN "ou=people,o=acme.com"
PerlSetVar LDAPServer ldap.acme.com
PerlSetVar LDAPPort 389
AuthNetLDAP.pm view on Meta::CPAN
=item PerlSetVar AlternatePWAttribute
The an alternate attribute with which the $password will be tested.
This allows you to test with another attribute, instead of just
trying to bind the userdn and password to the ldap server.
If this option is used, then a BindDN and BindPWD must be used for the
initial bind.
=item PerlSetVar AllowAlternateAuth
This attribute allows you to set an alternative method of authentication
(Basically, this allows you to mix authentication methods, if you don't have
AuthNetLDAP.pm view on Meta::CPAN
Then in your httpd.conf file or .htaccess file, in either a <Directory> or <Location> section put:
AuthName "LDAP Test Auth"
AuthType Basic
#only set the next two if you need to bind as a user for searching
#PerlSetVar BindDN "uid=user1,ou=people,o=acme.com" #optional
#PerlSetVar BindPWD "password" #optional
PerlSetVar BaseDN "ou=people,o=acme.com"
PerlSetVar LDAPServer ldap.acme.com
PerlSetVar LDAPPort 389
( run in 0.959 second using v1.01-cache-2.11-cpan-501a3233654 )