Skip to content

Commit

Permalink
LWP/Protocol/ldap.pm: refactor
Browse files Browse the repository at this point in the history 
* create objects consistently using 'CLASS->new(args)' instead of 'new CLASS args'
* indent method parameters for cleaner reading
* add comments
* harmonize coding style
* catch errors in Net::LDAP->new()
* fix calls of $ldap->code / $ldap->error to $mesg->code / $mesg->error
  • Loading branch information
@marschap
marschap committed Sep 6, 2012
1 parent 214f442 commit 6c1fecf
Showing 1 changed file with 56 additions and 41 deletions.
97 changes: 56 additions & 41 deletions lib/LWP/Protocol/ldap.pm
View file
Expand Up @@ -13,7 +13,7 @@ use LWP::MediaTypes ();
require LWP::Protocol; require LWP::Protocol;
@ISA = qw(LWP::Protocol); @ISA = qw(LWP::Protocol);


$VERSION = "1.16"; $VERSION = "1.17";


use strict; use strict;
eval { eval {
Expand All @@ -29,44 +29,44 @@ sub request {
LWP::Debug::trace('()') if defined &LWP::Debug::trace; LWP::Debug::trace('()') if defined &LWP::Debug::trace;


# check proxy # check proxy
if (defined $proxy) if (defined $proxy) {
{ return HTTP::Response->new(HTTP_BAD_REQUEST,
return new HTTP::Response HTTP_BAD_REQUEST, 'You can not proxy through the ldap');
'You can not proxy through the ldap';
} }


my $url = $request->url; my $url = $request->url;
my $scheme = $url->scheme; my $scheme = $url->scheme;
my $userinfo = $url->can('userinfo') ? $url->userinfo : '';
my $dn = $url->dn;
my @attrs = $url->attributes;
my $scope = $url->scope || 'base';
my $filter = $url->filter;


# check scheme
if ($scheme !~ /^ldap[si]?$/) { if ($scheme !~ /^ldap[si]?$/) {
return new HTTP::Response HTTP_INTERNAL_SERVER_ERROR, return HTTP::Response->new(HTTP_INTERNAL_SERVER_ERROR,
"LWP::Protocol::ldap::request called for '$scheme'"; "LWP::Protocol::ldap::request called for '$scheme'");
} }


# check method # check method
my $method = $request->method; my $method = $request->method;


unless ($method =~ /^(?:GET|HEAD)$/) { unless ($method =~ /^(?:GET|HEAD)$/) {
return new HTTP::Response HTTP_NOT_IMPLEMENTED, return HTTP::Response->new(HTTP_NOT_IMPLEMENTED,
'Library does not allow method ' . "Library does not allow method $method for '$scheme:' URLs");
"$method for '$scheme:' URLs";
} }


if ($init_failed) { if ($init_failed) {
return new HTTP::Response HTTP_INTERNAL_SERVER_ERROR, return HTTP::Response->new(HTTP_INTERNAL_SERVER_ERROR,
$init_failed; $init_failed);
} }


my $userinfo = $url->can('userinfo') ? $url->userinfo : '';
my ($user, $password) = defined($userinfo) ? split(":", $userinfo, 2) : (); my ($user, $password) = defined($userinfo) ? split(":", $userinfo, 2) : ();
my $dn = $url->dn; my %extn = $url->extensions;
my @attrs = $url->attributes; my $tls = exists($extn{'x-tls'}) ? 1 : 0;
my $scope = $url->scope || "base";
my $filter = $url->filter;
my %extn = $url->extensions;
my $tls = exists($extn{'x-tls'}) ? 1 : 0;
my $format = lc($extn{'x-format'} || 'html'); my $format = lc($extn{'x-format'} || 'html');


# analyse HTTP headers
if (my $accept = $request->header('Accept')) { if (my $accept = $request->header('Accept')) {
$format = 'ldif' if $accept =~ m!\btext/(x-)?ldif\b!; $format = 'ldif' if $accept =~ m!\btext/(x-)?ldif\b!;
} }
Expand All @@ -81,51 +81,67 @@ sub request {
} }
} }


# Create an initial response object # connect to LDAP server
my $response = new HTTP::Response HTTP_OK, "Document follows";
$response->request($request);

my $ldap = new Net::LDAP($url->as_string); my $ldap = new Net::LDAP($url->as_string);
if (!$ldap) {
my $res = HTTP::Response->new(HTTP_BAD_REQUEST,
"Connection to LDAP server failed");
$res->content_type("text/plain");
$res->content($@);
return $res;
}


# optional: startTLS
if ($tls && $scheme ne 'ldaps') { if ($tls && $scheme ne 'ldaps') {
my $mesg = $ldap->start_tls(); my $mesg = $ldap->start_tls();
if ($mesg->code) { if ($mesg->code) {
my $res = new HTTP::Response HTTP_BAD_REQUEST, my $res = HTTP::Response->new(HTTP_BAD_REQUEST,
"LDAP return code " . $mesg->code; "LDAP return code " . $mesg->code);
$res->content_type("text/plain"); $res->content_type("text/plain");
$res->content($mesg->error); $res->content($mesg->error);
return $res; return $res;
} }
} }


# optional: simple bind
if ($user) { if ($user) {
my $mesg = $ldap->bind($user, password => $password); my $mesg = $ldap->bind($user, password => $password);


if ($mesg->code) { if ($mesg->code) {
my $res = new HTTP::Response HTTP_BAD_REQUEST, "LDAP return code " . $mesg->code; my $res = HTTP::Response->new(HTTP_BAD_REQUEST,
"LDAP return code " . $mesg->code);
$res->content_type("text/plain"); $res->content_type("text/plain");
$res->content($mesg->error); $res->content($mesg->error);
return $res; return $res;
} }
} }


my @opts = (scope => $scope); # do the search
push @opts, "base" => $dn if $dn; my %opts = ( scope => $scope );
push @opts, "filter" => $filter if $filter; $opts{base} = $dn if $dn;
push @opts, "attrs" => \@attrs if @attrs; $opts{filter} = $filter if $filter;
$opts{attrs} = \@attrs if @attrs;


my $mesg = $ldap->search(@opts); my $mesg = $ldap->search(%opts);
if ($mesg->code) { if ($mesg->code) {
my $res = new HTTP::Response HTTP_BAD_REQUEST, my $res = HTTP::Response->new(HTTP_BAD_REQUEST,
"LDAP return code " . $ldap->code; "LDAP return code " . $mesg->code);
$res->content_type("text/plain"); $res->content_type("text/plain");
$res->content($ldap->error); $res->content($mesg->error);
return $res; return $res;
} }
elsif ($format eq 'ldif') {
# Create an initial response object
my $response = HTTP::Response->new(HTTP_OK, "Document follows");
$response->request($request);

# return data in the format requested
if ($format eq 'ldif') {
require Net::LDAP::LDIF; require Net::LDAP::LDIF;

open(my $fh, ">", \my $content); open(my $fh, ">", \my $content);
my $ldif = Net::LDAP::LDIF->new($fh,"w", version => 1); my $ldif = Net::LDAP::LDIF->new($fh, "w", version => 1);

while(my $entry = $mesg->shift_entry) { while(my $entry = $mesg->shift_entry) {
$ldif->write_entry($entry); $ldif->write_entry($entry);
} }
Expand All @@ -134,14 +150,14 @@ sub request {
$response->header('Content-Type' => 'text/ldif'); $response->header('Content-Type' => 'text/ldif');
$response->header('Content-Length', length($content)); $response->header('Content-Length', length($content));
$response = $self->collect_once($arg, $response, $content) $response = $self->collect_once($arg, $response, $content)
if ($method ne 'HEAD'); if ($method ne 'HEAD');
} }
else { else {
my $content = "<head><title>Directory Search Results</title></head>\n<body>"; my $content = "<head><title>Directory Search Results</title></head>\n<body>";
my $entry; my $entry;
my $index; my $index;


for($index = 0 ; $entry = $mesg->entry($index) ; $index++ ) { for ($index = 0 ; $entry = $mesg->entry($index); $index++) {
my $attr; my $attr;


$content .= $index ? qq{<tr><th colspan="2"><hr>&nbsp</tr>\n} : "<table>"; $content .= $index ? qq{<tr><th colspan="2"><hr>&nbsp</tr>\n} : "<table>";
Expand Down Expand Up @@ -175,8 +191,7 @@ sub request {
$response->header('Content-Type' => 'text/html'); $response->header('Content-Type' => 'text/html');
$response->header('Content-Length', length($content)); $response->header('Content-Length', length($content));
$response = $self->collect_once($arg, $response, $content) $response = $self->collect_once($arg, $response, $content)
if ($method ne 'HEAD'); if ($method ne 'HEAD');

} }


$ldap->unbind; $ldap->unbind;
Expand Down

0 comments on commit 6c1fecf

Please sign in to comment.