Hi,
this is outside the scope of this list,
but I would not expect that a perl object survives
between two invocations of a CGI script.
Regards
Peter
On Monday, 18. September 2006 22:35, Andrej Ricnik-Bay wrote:
> 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
--
Peter Marschall
[EMAIL PROTECTED]
