git.sur5r.net Git - openldap/blob - servers/slapd/back-sock/searchexample.pl

   1 #!/usr/bin/perl -w -T
   2
   3 # See: http://seamons.com/net_server/net_server.html
   4
   5 package ExampleDB;
   6
   7 use strict;
   8 use vars qw(@ISA);
   9 use Net::Server::PreFork; # any personality will do
  10
  11 @ISA = qw(Net::Server::PreFork);
  12
  13 ExampleDB->run(
  14   port=>"/tmp/example.sock|unix"
  15   #conf_file=>"/etc/example.conf"
  16 );
  17 exit;
  18
  19 ### over-ridden subs below
  20 # The protocol is the same as back-shell
  21
  22 sub process_request {
  23   my $self = shift;
  24
  25   eval {
  26
  27     local $SIG{ALRM} = sub { die "Timed Out!\n" };
  28     my $timeout = 30; # give the user 30 seconds to type a line
  29     alarm($timeout);
  30
  31     my $request = <STDIN>;
  32
  33     if ($request eq "SEARCH\n") {
  34       my %req = ();
  35       while (my $line = <STDIN>) {
  36         chomp($line);
  37         last if $line eq "";
  38         if ($line =~ /^([^:]+):\s*(.*)$/) { # FIXME: handle base64 encoded
  39           $req{$1} = $2;
  40         }
  41       }
  42       #sleep(2);  # to test concurrency
  43       print "dn: cn=test, dc=example, dc=com\n";
  44       print "cn: test\n";
  45       print "objectclass: cnobject\n";
  46       print "\n";
  47       print "RESULT\n";
  48       print "code: 0\n";
  49       print "info: answered by process $$\n";
  50     }
  51     else {
  52       print "RESULT\n";
  53       print "code: 53\n";  # unwillingToPerform
  54       print "info: I don't implement $request";
  55     }
  56
  57   };
  58
  59   return unless $@;
  60   if( $@=~/timed out/i ){
  61     print "RESULT\n";
  62     print "code: 3\n"; # timeLimitExceeded
  63     print "info: Timed out\n";
  64   }
  65   else {
  66     print "RESULT\n";
  67     print "code: 1\n"; # operationsError
  68     print "info: $@\n"; # FIXME: remove CR/LF
  69   }
  70
  71 }
  72
  73 1;