apache2-frontend/proxy_impl.pm

package proxy_impl;

use overload;

sub uriregex {
   overload::constant qr => sub {
      local $_ = shift;

      s/\./\\./g;
      s/·/./g;
      s/\*\*/.*/g;

      $_
   };
}

BEGIN { uriregex }

use Apache2::Const -compile => qw(
   OK DECLINED DONE NOT_FOUND SERVER_ERROR AUTH_REQUIRED FORBIDDEN
   PROXYREQ_REVERSE
);
use Apache2::RequestUtil ();
use Apache2::RequestRec ();
use Apache2::Connection ();
use Apache2::Util ();
use Apache2::URI ();

use APR::Const -compile => qw(
   FILETYPE_DIR FINFO_NORM
);
use APR::Error ();
use APR::Finfo ();

use common::sense;

# per-request values, cached here for performance, use them
our $req;  # Apache2::RquestRec
our $host; # $req->hostname
our $uri;  # $req->uri, already resolved .. and protects against %xx, hopefully
our $ip;   # $req->connection->client_ip, alternative ->useragent_ip

# finish immediately with given status
sub status($) {
   die \(my $status = shift);
}

#sub escape_path($) {
#   Apache2::Util::escape_path shift, $req->pool
#}

# escapes everything not allowed in a url hpath
sub pesc($) {
   local $_ = shift;

   s/([^A-Za-z0-9\$\-_.+!*'(),;?&=]\/)/sprintf "%02x", ord $1/ge;

   $_
}

# external redirect with status code
sub redirect($$) {
   my ($status, $location) = @_;

#   $location =~ s,^(http://[^/:]+)/,$1:34567/,;#d#

   $req->headers_out->set (Location => $location);
   status $status;
}

# permanent external redirect
sub rperm($) {
   redirect 301, shift
}

# temporary redirect, could be internal, but never is
sub rtemp($) {
   redirect 302, shift
}

# serve some path, do not call directly
sub _rpathname($) {
   my $path = shift;

   my $finfo = eval { APR::Finfo::stat $path, APR::Const::FINFO_NORM, $req->pool }
      or status Apache2::Const::NOT_FOUND;

   # let mod_dir, mod_autoindex and the default-handler handle this
   $req->filename ($path);
   $req->finfo ($finfo);
#   warn "serve <$path,",$req->handler,">\n";#d#
   status Apache2::Const::OK;
}

# serve a regular file from disk
sub rfile($) {
   $req->handler ("default-handler");
   &_rpathname
}

# serve a directory from disk
sub rdir($) {
   my $path = shift;

   if ($req->uri !~ m,/$,) {
      # redirect dir to dir/
      rperm $req->construct_url (pesc $req->uri . "/");

   } elsif (-e "$path/index.html") {
      # mod_dir emulation, display index.html if any
      $req->content_type ("text/html");
      rfile "$path/index.html";
   } elsif (-e "$path/index.xhtml") {
      $req->content_type ("text/html"); # we assume to follow the compatibility guidelines
      rfile "$path/index.xhtml";

   } else {
      # let mod_autoindex handle it later
      $req->handler ("httpd/unix-directory");
      _rpathname $path;
   }
}

# like rpath, but assumes caller already stat'ed
sub rpath_nostat {
   -d _ ? &rdir : &rfile
}

# serve a generic path, can be dir or file
sub rpath($) {
   stat $_[0];
   &rpath_nostat
}

# run a cgi script, first argument is script uri
sub rcgi($$) {
   my ($name, $path) = @_;

   (substr $uri, 0, length $name) eq $name
      or status 500;

   $req->path_info (substr $uri, length $name);

   $req->handler ("cgi-script");
   $req->notes->set ("alias-forced-type" => "cgi-script"); # leave a note for mod_cgi, so it ignores missing ExecCGI
   _rpathname $path;
}

# reverse proxy
# path is local root uri
# target is target root url
# suffix is appended to target url
sub rproxy($$$@) {
   my ($path, $target, $suffix, @lines) = @_;

   $req->proxyreq (Apache2::Const::PROXYREQ_REVERSE);
   $req->uri ($path);
   $req->filename ("proxy:$target$suffix");
   $req->handler ("proxy-server");
   $req->subprocess_env->set ("proxy-sendchunked", 1);
   #$notes->set ("proxy-nocanon", 1);
   #$env->set ("proxy-initial-not-pooled", 1);

   # disable compression, see http://www.apachetutor.org/admin/reverseproxies
   # $req->headers_in->unset ("accept-encoding");
   # alternatively recompress, SetOutputFilter INFLATE;DEFLATE

   (my $cpath = $path) =~ s/([^A-Za-z0-9\/.\-_])/sprintf "\\x%02x", ord $1/ge;

   push @lines, (
      "ProxyPassReverse /",
      "ProxyHTMLEnable on",
      "ProxyHTMLURLMap $target $cpath",
      "ProxyHTMLURLMap / $cpath/",
   );

#   warn "PROXY<$path,$target,$suffix>\n";#d#
#   warn map "$_\n",@lines;

   $req->add_config (\@lines, ~0, $path);
  
   status Apache2::Const::OK;
}

my $rules;

sub load_rules {
   open my $fh, "<:raw", Apache2::ServerUtil::server_root . "/rules"
      or die Apache2::ServerUtil::server_root . "/rules: $!";
   local $/;

   $rules = <$fh>;

   $rules = eval "BEGIN { uriregex }\nsub {\n#line 0 'rules'\n$rules\n}"
      or die $@;

   warn "proxy rules successfully loaded.\n";

   Apache2::Const::OK
}

sub map_to_storage {
   local $req = shift;
   local ($host, $uri, $ip) = ($req->hostname, $req->uri, $req->connection->client_ip);

   eval {
      # the uri is pre-parsed and "protected" by apache
      # the hostname is lowercased but otherwise completely unchecked,
      # so better be safe than sorry
      $host =~ /^[A-Za-z0-9\-.]+$/
         or status 404;

      # must have at least one dot
      $host =~ /./
         or status 404;

      local $_ = "$host$uri";
      $rules->($req);
   };

   if ($@) {
      if (SCALAR:: eq ref $@) {
         return ${$@};
      } else {
         die;
      }
   }

   Apache2::Const::NOT_FOUND
}

load_rules;

warn "proxy loaded and iniitalised.\n";

1

Revision:	1.1
Committed:	Mon Jun 15 18:16:47 2015 UTC (8 years, 11 months ago) by root
Branch:	MAIN
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	package proxy_impl;
2
3			use overload;
4
5			sub uriregex {
6			overload::constant qr => sub {
7			local $_ = shift;
8
9			s/\./\\./g;
10			s/·/./g;
11			s/\\/.*/g;
12
13			$_
14			};
15			}
16
17			BEGIN { uriregex }
18
19			use Apache2::Const -compile => qw(
20			OK DECLINED DONE NOT_FOUND SERVER_ERROR AUTH_REQUIRED FORBIDDEN
21			PROXYREQ_REVERSE
22			);
23			use Apache2::RequestUtil ();
24			use Apache2::RequestRec ();
25			use Apache2::Connection ();
26			use Apache2::Util ();
27			use Apache2::URI ();
28
29			use APR::Const -compile => qw(
30			FILETYPE_DIR FINFO_NORM
31			);
32			use APR::Error ();
33			use APR::Finfo ();
34
35			use common::sense;
36
37			# per-request values, cached here for performance, use them
38			our $req; # Apache2::RquestRec
39			our $host; # $req->hostname
40			our $uri; # $req->uri, already resolved .. and protects against %xx, hopefully
41			our $ip; # $req->connection->client_ip, alternative ->useragent_ip
42
43			# finish immediately with given status
44			sub status($) {
45			die \(my $status = shift);
46			}
47
48			#sub escape_path($) {
49			# Apache2::Util::escape_path shift, $req->pool
50			#}
51
52			# escapes everything not allowed in a url hpath
53			sub pesc($) {
54			local $_ = shift;
55
56			s/([^A-Za-z0-9\$\-_.+!*'(),;?&=]\/)/sprintf "%02x", ord $1/ge;
57
58			$_
59			}
60
61			# external redirect with status code
62			sub redirect($$) {
63			my ($status, $location) = @_;
64
65			# $location =~ s,^(http://[^/:]+)/,$1:34567/,;#d#
66
67			$req->headers_out->set (Location => $location);
68			status $status;
69			}
70
71			# permanent external redirect
72			sub rperm($) {
73			redirect 301, shift
74			}
75
76			# temporary redirect, could be internal, but never is
77			sub rtemp($) {
78			redirect 302, shift
79			}
80
81			# serve some path, do not call directly
82			sub _rpathname($) {
83			my $path = shift;
84
85			my $finfo = eval { APR::Finfo::stat $path, APR::Const::FINFO_NORM, $req->pool }
86			or status Apache2::Const::NOT_FOUND;
87
88			# let mod_dir, mod_autoindex and the default-handler handle this
89			$req->filename ($path);
90			$req->finfo ($finfo);
91			# warn "serve <$path,",$req->handler,">\n";#d#
92			status Apache2::Const::OK;
93			}
94
95			# serve a regular file from disk
96			sub rfile($) {
97			$req->handler ("default-handler");
98			&_rpathname
99			}
100
101			# serve a directory from disk
102			sub rdir($) {
103			my $path = shift;
104
105			if ($req->uri !~ m,/$,) {
106			# redirect dir to dir/
107			rperm $req->construct_url (pesc $req->uri . "/");
108
109			} elsif (-e "$path/index.html") {
110			# mod_dir emulation, display index.html if any
111			$req->content_type ("text/html");
112			rfile "$path/index.html";
113			} elsif (-e "$path/index.xhtml") {
114			$req->content_type ("text/html"); # we assume to follow the compatibility guidelines
115			rfile "$path/index.xhtml";
116
117			} else {
118			# let mod_autoindex handle it later
119			$req->handler ("httpd/unix-directory");
120			_rpathname $path;
121			}
122			}
123
124			# like rpath, but assumes caller already stat'ed
125			sub rpath_nostat {
126			-d _ ? &rdir : &rfile
127			}
128
129			# serve a generic path, can be dir or file
130			sub rpath($) {
131			stat $_[0];
132			&rpath_nostat
133			}
134
135			# run a cgi script, first argument is script uri
136			sub rcgi($$) {
137			my ($name, $path) = @_;
138
139			(substr $uri, 0, length $name) eq $name
140			or status 500;
141
142			$req->path_info (substr $uri, length $name);
143
144			$req->handler ("cgi-script");
145			$req->notes->set ("alias-forced-type" => "cgi-script"); # leave a note for mod_cgi, so it ignores missing ExecCGI
146			_rpathname $path;
147			}
148
149			# reverse proxy
150			# path is local root uri
151			# target is target root url
152			# suffix is appended to target url
153			sub rproxy($$$@) {
154			my ($path, $target, $suffix, @lines) = @_;
155
156			$req->proxyreq (Apache2::Const::PROXYREQ_REVERSE);
157			$req->uri ($path);
158			$req->filename ("proxy:$target$suffix");
159			$req->handler ("proxy-server");
160			$req->subprocess_env->set ("proxy-sendchunked", 1);
161			#$notes->set ("proxy-nocanon", 1);
162			#$env->set ("proxy-initial-not-pooled", 1);
163
164			# disable compression, see http://www.apachetutor.org/admin/reverseproxies
165			# $req->headers_in->unset ("accept-encoding");
166			# alternatively recompress, SetOutputFilter INFLATE;DEFLATE
167
168			(my $cpath = $path) =~ s/([^A-Za-z0-9\/.\-_])/sprintf "\\x%02x", ord $1/ge;
169
170			push @lines, (
171			"ProxyPassReverse /",
172			"ProxyHTMLEnable on",
173			"ProxyHTMLURLMap $target $cpath",
174			"ProxyHTMLURLMap / $cpath/",
175			);
176
177			# warn "PROXY<$path,$target,$suffix>\n";#d#
178			# warn map "$_\n",@lines;
179
180			$req->add_config (\@lines, ~0, $path);
181
182			status Apache2::Const::OK;
183			}
184
185			my $rules;
186
187			sub load_rules {
188			open my $fh, "<:raw", Apache2::ServerUtil::server_root . "/rules"
189			or die Apache2::ServerUtil::server_root . "/rules: $!";
190			local $/;
191
192			$rules = <$fh>;
193
194			$rules = eval "BEGIN { uriregex }\nsub {\n#line 0 'rules'\n$rules\n}"
195			or die $@;
196
197			warn "proxy rules successfully loaded.\n";
198
199			Apache2::Const::OK
200			}
201
202			sub map_to_storage {
203			local $req = shift;
204			local ($host, $uri, $ip) = ($req->hostname, $req->uri, $req->connection->client_ip);
205
206			eval {
207			# the uri is pre-parsed and "protected" by apache
208			# the hostname is lowercased but otherwise completely unchecked,
209			# so better be safe than sorry
210			$host =~ /^[A-Za-z0-9\-.]+$/
211			or status 404;
212
213			# must have at least one dot
214			$host =~ /./
215			or status 404;
216
217			local $_ = "$host$uri";
218			$rules->($req);
219			};
220
221			if ($@) {
222			if (SCALAR:: eq ref $@) {
223			return ${$@};
224			} else {
225			die;
226			}
227			}
228
229			Apache2::Const::NOT_FOUND
230			}
231
232			load_rules;
233
234			warn "proxy loaded and iniitalised.\n";
235
236			1
237