[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/site_perl/5.10.0/LWP/Protocol/ -> ldap.pm (source)

   1  # Copyright (c) 1998-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
   2  # This program is free software; you can redistribute it and/or
   3  # modify it under the same terms as Perl itself.
   4  
   5  package LWP::Protocol::ldap;
   6  
   7  use Carp ();
   8  
   9  use HTTP::Status ();
  10  use HTTP::Negotiate ();
  11  use HTTP::Response ();
  12  use LWP::MediaTypes ();
  13  require LWP::Protocol;
  14  @ISA = qw(LWP::Protocol);
  15  
  16  $VERSION = "1.10";
  17  
  18  use strict;
  19  eval {
  20    require Net::LDAP;
  21  };
  22  my $init_failed = $@ ? $@ : undef;
  23  
  24  sub request {
  25    my($self, $request, $proxy, $arg, $size, $timeout) = @_;
  26  
  27    $size = 4096 unless $size;
  28  
  29    LWP::Debug::trace('()');
  30  
  31    # check proxy
  32    if (defined $proxy)
  33    {
  34      return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  35                   'You can not proxy through the ldap';
  36    }
  37  
  38    my $url = $request->url;
  39    if ($url->scheme ne 'ldap') {
  40      my $scheme = $url->scheme;
  41      return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  42              "LWP::Protocol::ldap::request called for '$scheme'";
  43    }
  44  
  45    # check method
  46    my $method = $request->method;
  47  
  48    unless ($method eq 'GET') {
  49      return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  50                   'Library does not allow method ' .
  51                   "$method for 'ldap:' URLs";
  52    }
  53  
  54    if ($init_failed) {
  55      return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  56              $init_failed;
  57    }
  58  
  59    my $host     = $url->host;
  60    my $port     = $url->port;
  61    my ($user, $password) = split(":", $url->userinfo, 2);
  62  
  63    # Create an initial response object
  64    my $response = new HTTP::Response &HTTP::Status::RC_OK, "Document follows";
  65    $response->request($request);
  66  
  67    my $ldap = new Net::LDAP($host, port => $port);
  68  
  69    my $mesg = $ldap->bind($user, password => $password);
  70  
  71    if ($mesg->code) {
  72      my $res = new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  73           "LDAP return code " . $ldap->code;
  74      $res->content_type("text/plain");
  75      $res->content($ldap->error);
  76      return $res;
  77    }
  78  
  79    my $dn = $url->dn;
  80    my @attrs = $url->attributes;
  81    my $scope = $url->scope || "base";
  82    my $filter = $url->filter;
  83    my @opts = (scope => $scope);
  84    
  85    push @opts, "base" => $dn if $dn;
  86    push @opts, "filter" => $filter if $filter;
  87    push @opts, "attrs" => \@attrs if @attrs;
  88  
  89    $mesg = $ldap->search(@opts);
  90    if ($mesg->code) {
  91      my $res = new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  92           "LDAP return code " . $ldap->code;
  93      $res->content_type("text/plain");
  94      $res->content($ldap->error);
  95      return $res;
  96    }
  97    else {
  98      my $content = "<head><title>Directory Search Results</title></head>\n<body>";
  99      my $entry;
 100      my $index;
 101  
 102      for($index = 0 ; $entry = $mesg->entry($index) ; $index++ ) {
 103        my $attr;
 104  
 105        $content .= $index ? qq{<tr><th colspan="2"><hr>&nbsp</tr>\n} : "<table>";
 106  
 107        $content .= qq{<tr><th colspan="2">} . $entry->dn . "</th></tr>\n";
 108  
 109        foreach $attr ($entry->attributes) {
 110          my $vals = $entry->get_value($attr, asref => 1);
 111          my $val;
 112  
 113          $content .= q{<tr><td align="right" valign="top"};
 114          $content .= q{ rowspan="} . scalar(@$vals) . q{"}
 115            if (@$vals > 1);
 116          $content .= ">" . $attr  . "&nbsp</td>\n";
 117  
 118          my $j = 0;
 119          foreach $val (@$vals) {
 120        $val = qq!<a href="$val">$val</a>! if $val =~ /^https?:/;
 121        $val = qq!<a href="mailto:$val">$val</a>! if $val =~ /^[-\w]+\@[-.\w]+$/;
 122            $content .= "<tr>" if $j++;
 123            $content .= "<td>" . $val . "</td></tr>\n";
 124          }
 125        }
 126      }
 127  
 128      $content .= "</table>" if $index;
 129      $content .= "<hr>";
 130      $content .= $index ? sprintf("%s Match%s found",$index, $index>1 ? "es" : "")
 131                 : "<b>No Matches found</b>";
 132      $content .= "</body>\n";
 133      $response->header('Content-Type' => 'text/html');
 134      $response->header('Content-Length', length($content));
 135      $response = $self->collect_once($arg, $response, $content)
 136      if ($method ne 'HEAD');
 137  
 138    }
 139  
 140    $ldap->unbind;
 141  
 142    $response;
 143  }
 144  
 145  1;


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1