File: proxy.pl

package info (click to toggle)
libpoe-component-server-simplehttp-perl 2.30-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 324 kB
  • sloc: perl: 1,324; makefile: 7
file content (135 lines) | stat: -rw-r--r-- 3,020 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
use strict;
use warnings;
sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 }
use POE qw(Component::Client::HTTP Component::Server::SimpleHTTP);
use POE::Component::Server::SimpleHTTP::Response;

# Stolen from POE::Wheel. This is static data, shared by all
my $current_id = 0;
my %active_identifiers;

sub _allocate_identifier {
  while (1) {
    last unless exists $active_identifiers{ ++$current_id };
  }
  return $active_identifiers{$current_id} = $current_id;
}

sub _free_identifier {
  my $id = shift;
  delete $active_identifiers{$id};
}

my $agent = 'proxy' . $$;
my $httpd = 'HTTPD' . $$;

POE::Component::Client::HTTP->spawn(
  Alias => $agent,
  Streaming => 4096,
);

POE::Component::Server::SimpleHTTP->new(
  KEEPALIVE     =>      1,
  ALIAS         =>      $httpd,
  PORT          =>      11111,
  PROXYMODE	 => 	 1,
  HANDLERS	 =>	 [
	{
          DIR           =>      '.*',
          SESSION       =>      'controller',
          EVENT         =>      'got_request',
	},
  ],
);

POE::Session->create(
   package_states => [
	main => [qw(_start got_request _got_stream _response)],
   ],
);

$poe_kernel->run();
exit 0;

sub _start {
  $poe_kernel->alias_set( 'controller' );
  return;
}

sub got_request {
  my($kernel,$heap,$request,$response,$dirmatch) = @_[KERNEL,HEAP,ARG0..ARG2];
  my $httpd = $_[SENDER]->get_heap();
  use Data::Dumper;
  $Data::Dumper::Indent=1;
  print Dumper( $response );
  # Check for errors
  if ( ! defined $request ) {
     $kernel->post( $httpd, 'DONE', $response );
     return;
  }

  $request->header('Connection', 'Keep-Alive');
  $request->remove_header('Accept-Encoding');

  # Let's see if it is a CONNECT request
  warn $request->as_string;
  warn $request->method, "\n";

  if ( $request->method eq 'CONNECT' ) {
     my $uri = $request->uri;
  #   warn $uri->authority, "\n";
     warn $uri->as_string, "\n";
  }

  $response->stream(
     session     => 'controller',
     event       => '_got_stream',
     dont_flush  => 1
  );

  my $id = _allocate_identifier();
  $kernel->post( 
    $agent, 
    'request',
    '_response',
    $request, 
    "$id",
  );

  $heap->{_requests}->{ $id } = $response;
  return;
}

sub _response {
  my ($kernel,$heap,$request_packet,$response_packet) = @_[KERNEL,HEAP,ARG0,ARG1];
  my $id = $request_packet->[1];
  my $resp = $heap->{_requests}->{ $id };
  
  my $response = _rebless( $resp, $response_packet->[0] );
  my $chunk    = $response_packet->[1];

  warn $response->headers_as_string, "\n";

  if ( $chunk ) {
    $response->content( $chunk );
    $kernel->post( $httpd, 'STREAM', $response );
  }
  else {
    $kernel->post( $httpd, 'DONE', $response );
  }

  return;
}

sub _got_stream {
  my ($kernel,$heap,$response) = @_[KERNEL,HEAP,ARG0];
  return;
}

sub _rebless {
  my ($orig,$new) = @_;
  $new->{$_} = $orig->{$_} for grep { exists $orig->{$_} }
    qw(_WHEEL connection STREAM_SESSION STREAM DONT_FLUSH IS_STREAMING);
  bless $new, 'POE::Component::Server::SimpleHTTP::Response';
  return $new;
}