1 | #!/usr/bin/perl -w
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 |
|
---|
5 | ##use CGI;
|
---|
6 |
|
---|
7 | use LWP;
|
---|
8 |
|
---|
9 | use URI::Escape;
|
---|
10 |
|
---|
11 | sub main
|
---|
12 | {
|
---|
13 | # my $cgi = new CGI();
|
---|
14 |
|
---|
15 | ## print STDOUT "Access-Control-Allow-Origin: *\n";
|
---|
16 |
|
---|
17 | my $query_string = $ENV{"QUERY_STRING"};
|
---|
18 |
|
---|
19 | if (defined $query_string && ($query_string !~ m/^\s*$/)) {
|
---|
20 |
|
---|
21 | # define user agent
|
---|
22 | my $ua = LWP::UserAgent->new();
|
---|
23 | $ua->agent("USER/AGENT/IDENTIFICATION");
|
---|
24 |
|
---|
25 | ## print STDERR "**** query string = $query_string\n\n";
|
---|
26 |
|
---|
27 | my $url = uri_unescape($query_string);
|
---|
28 | ## print STDERR "*** orign url = $url\n\n";
|
---|
29 |
|
---|
30 | # if ($url =~ m/^(.*?)\?(.*?)$/) {
|
---|
31 | # # $url = $1 . "?" . uri_escape($2);
|
---|
32 | # $url = $1;
|
---|
33 | # my $cgiargs = $2;
|
---|
34 | # $cgiargs =~ s/\+/%2B/g;
|
---|
35 | #
|
---|
36 | # $url .= "?$cgiargs";
|
---|
37 |
|
---|
38 | ### print STDERR "*** new url = $url\n\n";
|
---|
39 | # }
|
---|
40 |
|
---|
41 | my $user = 'admin';
|
---|
42 | my $pass = 'admin';
|
---|
43 |
|
---|
44 | # make request
|
---|
45 | my $request = HTTP::Request->new(GET => $url);
|
---|
46 |
|
---|
47 | # authenticate
|
---|
48 | $request->authorization_basic($user, $pass);
|
---|
49 |
|
---|
50 | # get response
|
---|
51 | my $response = $ua->request($request);
|
---|
52 |
|
---|
53 | if ($response->is_success()) {
|
---|
54 |
|
---|
55 | my $content_type = $response->content_type();
|
---|
56 |
|
---|
57 | my $content = $response->content();
|
---|
58 |
|
---|
59 | if ($content_type eq "text/html") {
|
---|
60 | if ($content !~ m/<base.*?>/i) {
|
---|
61 | my $base_url = $url;
|
---|
62 | $base_url =~ s/[^\/]*$//; # cut URL down to the last '/'
|
---|
63 |
|
---|
64 | $content =~ s/<(head)>/<$1>\n<base href="$base_url"\/>/i;
|
---|
65 | }
|
---|
66 | }
|
---|
67 |
|
---|
68 |
|
---|
69 | print STDOUT "Content-type:$content_type\n\n";
|
---|
70 | print STDOUT $content;
|
---|
71 |
|
---|
72 | }
|
---|
73 | else {
|
---|
74 | # did not exist
|
---|
75 | print STDOUT "Status: 404 Not Found\n";
|
---|
76 | print STDOUT "Content-type:text/html\n\n";
|
---|
77 | print STDOUT "<html><body><p>Error: Failed to retrieve $url\n<p>",$response->content(),"</body></html>\n";
|
---|
78 |
|
---|
79 | }
|
---|
80 | }
|
---|
81 | else {
|
---|
82 | print STDOUT "Content-type:text/html\n\n";
|
---|
83 | print STDOUT "<html><body><p>Error: No GET arguments found in QUERY_STRING</body></html>\n";
|
---|
84 | }
|
---|
85 | }
|
---|
86 |
|
---|
87 | main();
|
---|