Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 137 lines (103 sloc) 2.902 kB
caea2b2 @marschap add simple proxy by H. Klunder
marschap authored
1 #!/usr/bin/perl
2 # Copyright (c) 2006 Hans Klunder <hans.klunder@bigfoot.com>. All rights reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the same terms as Perl itself.
5
6
7 use strict;
8 use warnings;
9
10 use IO::Select;
11 use IO::Socket;
12 use Data::Dumper;
13 use Convert::ASN1 qw(asn_read);
14 use Net::LDAP::ASN qw(LDAPRequest LDAPResponse);
15 our $VERSION = '0.1';
16 use fields qw(socket target);
17
18
19 sub handle($$)
20 {
21 my $clientsocket = shift;
22 my $serversocket = shift;
23
24 # read from client
25 asn_read($clientsocket, my $reqpdu);
26 log_request($reqpdu);
27
28 # send to server
29 print $serversocket $reqpdu or die "Could not send PDU to server\n";
30
31 # read from server
32 my $ready;
33 my $sel = IO::Select->new($serversocket);
34 for( $ready = 1 ; $ready ; $ready = $sel->can_read(0)) {
35 asn_read($serversocket, my $respdu) or return 1;
36 log_response($respdu);
37 # and send the result to the client
38 print $clientsocket $respdu;
39 }
40
41 return 0;
42 }
43
44
45 sub log_request($)
46 {
47 my $pdu = shift;
48
49 print '-' x 80,"\n";
50 print "Request ASN 1:\n";
51 Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
52 print "Request Perl:\n";
53 my $request = $LDAPRequest->decode($pdu);
54 print Dumper($request);
55 }
56
57
58 sub log_response($)
59 {
60 my $pdu = shift;
61
62 print '-' x 80,"\n";
63 print "Response ASN 1:\n";
64 Convert::ASN1::asn_hexdump(\*STDOUT,$pdu);
65 print "Response Perl:\n";
66 my $response = $LDAPResponse->decode($pdu);
67 print Dumper($response);
68 }
69
70
71 sub run_proxy($$)
72 {
73 my $listenersock = shift;
74 my $targetsock = shift;
75
0684841 @marschap fix typo in previous commit to simple-proxy.pl.
marschap authored
76 return unless ($listenersock && $targetsock);
caea2b2 @marschap add simple proxy by H. Klunder
marschap authored
77
78 my $sel = IO::Select->new($listenersock);
79 my %Handlers;
80 while (my @ready = $sel->can_read) {
81 foreach my $fh (@ready) {
82 if ($fh == $listenersock) {
83 # let's create a new socket
84 my $psock = $listenersock->accept;
85 $sel->add($psock);
86 } else {
87 my $result = handle($fh,$targetsock);
88 if ($result) {
89 # we have finished with the socket
90 $sel->remove($fh);
91 $fh->close;
92 delete $Handlers{*$fh};
93 }
94 }
95 }
96 }
97 }
98
99
100 my $listenersock = IO::Socket::INET->new(
101 Listen => 5,
102 Proto => 'tcp',
103 Reuse => 1,
104 LocalPort => 7070 )
105 or die "Could not create listener socket: $!\n";
106
107
108 my $targetsock = IO::Socket::INET->new(
109 Proto => 'tcp',
110 PeerAddr => 'localhost',
111 PeerPort => 8080 )
112 or die "Could not create connection to server: $!\n";
113
114 run_proxy($listenersock,$targetsock);
115
116 1;
117
118 __END__
119
120
121 Hi,
122
123 I noticed in the TODO that there was a request for a simple proxy which
124 can act as a man-in-the-middle.
125
126 Well, the attached script provides such a proxy, it is really a simple
127 proxy as it can currently handle only one client at the time, it will
128 dump requests and responses to STDOUT both in ASN1 and as perl structure.
129
130 Cheers,
131
132 Hans
133 ps. If you need a little more power like returning entries on a query I
134 suggest to have a look at Net::LDAP::Server on CPAN.
135
136 # EOF
Something went wrong with that request. Please try again.