Приглашаем посетить

11.1 The Setup

Our program arrives in the form of a CGI program called dirsearch.cgi, and it is the target of a form that accepts inputs named username, location, and haircolor. It may help to understand what this program is doing if we look at the input form for this program and its response (see Figures 11.1 and 11.2):

Figure 11.1. Input form for dirsearch.cgi.

graphics/11fig01.gif

Figure 11.2. Output from dirsearch.cgi.

graphics/11fig02.gif

Here is the code:

Example 11.1. dirsearch.cgi, Version 1


1  #!/usr/local/bin/duaperl

2

3  print "Content-type: text/html\n\n";

4

5  @values = split(/&/, $ENV{'QUERY_STRING'});

6  foreach $input (@values)

7  {

8    ($one, $two) = split(/=/,$input);

9    $filter && do_error("Cannot lookup by >1 attribute... pick one only");

10   $filter = "($one=$two)";

11 }

12 $filter || do_error("Need an attribute to search on");

13 &dua_settmout(10, 0);

14 unless (&dua_open("whitepages", 389, $dn, $pwd))

15 {

16   $msg = "Can't connect to whitepages: $dua_errstr";

17   do_email($msg);

18   do_error($msg);

19 }

20 $scope = 1;

21 $all = 0;

22 $rdn = '@dc=oz@dc=city@dc=emerald@dc=wp@ou=People';

23 %list = &dua_find($rdn, $filter, $scope, $all);

24 if ($dua_errstr)

25 {

26   do_email($dua_errstr);

27   do_error($dua_errstr);

28 }

29 unless (%list)

30 {

31   print "<HTML><HEAD><TITLE>Error</TITLE></HEAD><BODY>\n";

32   print "<H1>Error</H1><P>No match for $filter</P>\n";

33   print "</BODY></HTML>\n";

34   exit;

35 }

36 print "<HTML><HEAD><TITLE>Search Results</TITLE></HEAD>\n";

37 print "<BODY><H1>Results of search for $filter</H1>\n";

38 print "<TABLE BORDER=\"1\">\n";

39 print <<HEADER;

40 <TR><TH>username</TH>

41 <TH>location</TH>

42 <TH>haircolor</TH>

43 <TH>telephone</TH>

44 <TH>email</TH>

45 <TH>fax</TH>

46 <TH>name</TH></TR>

47 HEADER

48 foreach $i (sort { $a <=> $b } keys %list)

49 {

50   $dn = "\@". join("\@", reverse(split(/,\s*/, $list{$i})));

51   %attr = &dua_show($dn);

52   $username = $attr{'username'};

53   $location = $attr{'location'};

54   $haircolor = $attr{'haircolor'};

55   $telephone = $attr{'telephone'};

56   $email = $attr{'email'};

57   $fax = $attr{'fax'};

58   $name = $attr{'name'};

59   print "<TR><TD>$username</TD><TD>$location</TD>";

60   print "<TD>$haircolor</TD><TD>$telephone</TD>";

61   print "<TD>$email</TD><TD>$fax</TD><TD>$name</TD></TR>\n";

62 }

63 print "</TABLE></BODY></HTML>\n";

64

65 &dua_close();

66

67 sub do_error

68 {

69   local $mess = shift;

70   return unless $mess;

71   print "<HTML><HEAD><TITLE>Error</TITLE></HEAD><BODY>\n";

72   print "<H1>Error</H1><P>$mess</P>\n";

73   print "</BODY></HTML>\n";

74   exit;

75 }

76

77 sub do_email

78 {

79   local $mess = shift;

80   open MAIL, "|/usr/lib/sendmail -oi -t";

81   print MAIL "To: me\@here\n";

82   print MAIL "Subject: $0: LDAP lookup problem\n";

83   print MAIL "\n";

84   print MAIL "Error in LDAP processing in $0:\n\n";

85   print MAIL "$mess\n";

86   close MAIL;

87 }

Table of Contents