On 9/19/06, Peter Marschall <[EMAIL PROTECTED]> wrote:
Hi,
Hi Peter,


Please keep your reply to the list !!!
You deprive others of the help you get if you send personal mail
in response to posts that help you with your requests.
Sorry, only clicking on the reply is a bad habit, I'll watch it.


You still do work with packages !
Nope - that was just to point out that I had used the package in the
original script since you asked about that.  The new version doesn't
have it at all


Why don't you do it the clean way:
pass the $ldap object as a parameter to search_it()
instead of relying on global variables, which is
a bad habit anyway.
I had tried that, too, with no effect.


From what I can tell, the problem described is neither
a timing problem nor a problem of perl-ldap.
Hmmm ... where else to look (if it blows the scope of the list)?

Here's the full script (not overly elegant, I admit).

--------8<--------8<--------8<--------8<--------8<--------8<--------8<--------
#!/usr/bin/perl -w
# Andrej  - [EMAIL PROTECTED]
# On our way to a CGI script that queries LDAP and outputs CSV
use strict;
use Net::LDAP;
use Net::LDAP::Search;
use Net::LDAP::Entry;

our (
 $ldap,                $ldapbasedn,           $ldappassword,
 $value,               $data,                 $ldapuser,
 $mesg,                $query,                 %token,
 $attr,                $entr,                 $param,
 @entry
);    #declared via "our" because we have external components writing to these
use vars qw($pair @pairs $name $data $ldappassword $ldapuser $query);
 # for when "our" isn't good enough =/
sub print_header() {
print <<END;
 Content-type: text/html\n\n
 <HTML>
   <HEAD>
     <meta http-equiv="Content-Type" content="text/html">
     <meta name="GENERATOR" content="vim - baby!">
     <title>LDAP query => CSV output</title>
   </HEAD>
   <BODY>
END
}

sub print_footer() {
print <<END;
   </BODY>
 </HTML>
END
}


#ldap connection for spitting data at.
sub ldapconnect {
 #Connect
 $ldap = Net::LDAP->new( "auth", port => 389, async => 0 );
 if ( !defined $ldap ) {
   exit;
 }

#Authenticate
 print "<br>in ldapconnect<br>\n";
 my $mesg = $ldap->bind( $ldapuser, password => $ldappassword );
 my $result = parseldapresponse($mesg);
 if ( $result ne "0000" ) {
   # debug-info
   print "<br>leaving ldapconnect with error<br>\n";
   exit;
 }
 # debug-info
 print "<br>leaving ldapconnect<br>\n";
}


sub parseldapresponse {
 my ($mesg) = @_;
 my $errorcode = $mesg->code;
 # debug-info
 print "<BR<BR>Errorcode:  $errorcode <BR><BR>\n";
 return "0000" if ( $errorcode == 0 );
 return "2003"
   if ( $errorcode == 20 || $errorcode == 68 )
   ;    # attribute exists or value exists
 return "2000"
   if ( ( $errorcode > 15 && $errorcode < 37 )
   || ( $errorcode > 63 && $errorcode < 71 )
   || $errorcode == 53 );
 return "3000";
}

sub show_attrs {
print <<END;
 <FORM METHOD="POST" ACTION="./ldapcsv.cgi">
 <SELECT NAME="Attributes" SIZE="10" MULTIPLE>
END

 open MYLIST, '<../htdocs/attributes.conf' or die "Can't open file";
 while( <MYLIST>){
   print "<OPTION VALUE=\"$_\">$_</OPTION>\n";
 };
 close MYLIST;

 print <<END2;
 </SELECT>
 <INPUT TYPE="SUBMIT" NAME="Process">
END2
}

sub search_it {
 print "<BR>In search_it:  <BR>\n";
 my ( $param ) = @_ ;
 $mesg = $ldap->search(
   base      => 'ou=people,ou=users,o=org',
   filter    => "(uid=*)",
   scope     => 'sub',
   attrs     => [ $param ],
   timelimit => 90
 );
 if ( $mesg->code == 0 ) {
   my @entry = $mesg->entries;
   if (@entry) {
     foreach my $entr (@entry) {
       my $attr;
       foreach $attr ( sort $entr->attributes ) {
         print "  $attr : ", $entr->get_value($attr), "\n";
       }
     }
   }
 }
}

sub process_attrs {
 @pairs = split( "&", $data);
 #print "Anything here at all? $data <BR>\n";
 foreach $pair (@pairs) {
   $name=""; $value="";
   #  print "<BR>SPACER<BR> $#pairs <BR>\n";
   $pair =~ tr/+/ /;
   $pair =~ s/%(..)/pack("C", hex($1))/eg;
   $pair =~ m/(\w+)(?:=)?(.+)/    ;
   if( defined $2 && $2 ne "=" ) {
     $name=$1;
     $value=$2;
     chomp $name;
     chomp $value;
     if ( $name =~ /Attributes/ && defined $query ){
       $query .= ", '".$value."'"
     } else {
       $query = "'".$value."'"
     }
   }
 }
}


sub get_login {
 @pairs = split( "&", $data);
 foreach $pair (@pairs) {
   $pair =~ tr/+/ /;
   $pair =~ s/%(..)/pack("C", hex($1))/eg;
   $pair =~ m/(\w+)(?:=)?(.+)/    ;
   if( defined $2) {
     $name=$1;
     $value=$2;
     chomp $name;
     chomp $value;
     print "<BR>Name: $name \tValue: $value <BR> \n";
     $token{$name} = $value;
   }
 }
 $ldapuser = $token{"cn"};
 $ldappassword = $token{"passwd"};
}

sub print_login {
print <<END;
 <HTML>
   <HEAD>
     <TITLE>ldap query</TITLE>
   </HEAD>
   <BODY>
     <P>Please supply your LDAP credentials</P>
     <FORM METHOD="POST" ACTION="./ldapcsv.cgi">
     <INPUT TYPE="TEXT" NAME="cn" MAXLENGTH="25" SIZE="25" ><BR>
     <INPUT TYPE="PASSWORD" NAME="passwd" SIZE="25" MAXLENGTH="25"><BR>
     <INPUT TYPE="SUBMIT" NAME="Login">
   </BODY>
 </HTML>
END
}

print_header();
read( STDIN, $data, $ENV{"CONTENT_LENGTH"});
if( length $data == 0 ){
 print_login();
}
if( $data =~ /Login/){
 get_login();
 print "<BR> $ldapuser<BR>\n";
 ldapconnect();
 show_attrs();
}
if( $data =~ /Process/){
 print "<BR>Process clicked!<BR>\n";
 process_attrs();
 print "<BR> $query <BR>\n";
 search_it( $query );
}
print_footer();

--------8<--------8<--------8<--------8<--------8<--------8<--------8<--------
I still find it odd that connect & bind work, but search fails...



Peter
Cheers,
Andrej

Reply via email to