← Back to branch summary

~ubuntu-branches/ubuntu/trusty/wget/trusty-updates

« back to all changes in this revision

Viewing changes to tests/HTTPServer.pm

  • Committer: Bazaar Package Importer
  • Author(s): Marc Deslauriers
  • Date: 2009-12-12 08:15:59 UTC
  • mfrom: (2.1.5 squeeze)
  • Revision ID: james.westby@ubuntu.com-20091212081559-mvccl4kzdqb138y3
Tags: 1.12-1.1ubuntu1
* Merge from debian testing, remaining changes:
  - Add wget-udeb to ship wget.gnu as alternative to busybox wget
    implementation.
* Keep build dependencies in main:
  - debian/control: remove info2man build-dep
  - debian/patches/00list: disable wget-infopod_generated_manpage.dpatch

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/HTTPServer.pm
1
 
#!/usr/bin/perl -w
2
 
 
3
1
package HTTPServer;
4
2
 
5
3
use strict;
 
4
use warnings;
6
5
 
7
6
use HTTP::Daemon;
8
7
use HTTP::Status;
23
22
        if (!$initialized) {
24
23
            $synch_callback->();
25
24
            $initialized = 1;
26
 
        }        
 
25
        }
27
26
        my $con = $self->accept();
28
27
        print STDERR "Accepted a new connection\n" if $log;
29
28
        while (my $req = $con->get_request) {
30
 
            my $url_path = $req->url->path;
 
29
            #my $url_path = $req->url->path;
 
30
            my $url_path = $req->url->as_string;
31
31
            if ($url_path =~ m{/$}) { # append 'index.html'
32
32
                $url_path .= 'index.html';
33
33
            }
45
45
            if (exists($urls->{$url_path})) {
46
46
                print STDERR "Serving requested URL: ", $url_path, "\n" if $log;
47
47
                next unless ($req->method eq "HEAD" || $req->method eq "GET");
48
 
                
 
48
 
49
49
                my $url_rec = $urls->{$url_path};
50
50
                $self->send_response($req, $url_rec, $con);
51
51
            } else {
52
52
                print STDERR "Requested wrong URL: ", $url_path, "\n" if $log;
53
53
                $con->send_error($HTTP::Status::RC_FORBIDDEN);
54
54
                last;
55
 
            }            
 
55
            }
56
56
        }
57
57
        print STDERR "Closing connection\n" if $log;
58
58
        $con->close;
68
68
    if (exists $url_rec->{'auth_method'}) {
69
69
        ($send_content, $code, $msg, $headers) =
70
70
            $self->handle_auth($req, $url_rec);
 
71
    } elsif (!$self->verify_request_headers ($req, $url_rec)) {
 
72
        ($send_content, $code, $msg, $headers) =
 
73
            ('', 400, 'Mismatch on expected headers', {});
71
74
    } else {
72
75
        ($code, $msg) = @{$url_rec}{'code', 'msg'};
73
76
        $headers = $url_rec->{headers};
92
95
            print $con $content;
93
96
            next;
94
97
        }
95
 
        if ($req->header("Range")) {
 
98
        if ($req->header("Range") && !$url_rec->{'force_code'}) {
96
99
            $req->header("Range") =~ m/bytes=(\d*)-(\d*)/;
97
100
            my $content_len = length($content);
98
101
            my $start = $1 ? $1 : 0;
99
102
            my $end = $2 ? $2 : ($content_len - 1);
100
103
            my $len = $2 ? ($2 - $start) : ($content_len - $start);
101
 
            $resp->header("Accept-Ranges" => "bytes");
102
 
            $resp->header("Content-Length" => $len);
103
 
            $resp->header("Content-Range" => "bytes $start-$end/$content_len");
104
 
            $resp->header("Keep-Alive" => "timeout=15, max=100");
105
 
            $resp->header("Connection" => "Keep-Alive");
106
 
            $con->send_basic_header(206, "Partial Content", $resp->protocol);
107
 
            print $con $resp->headers_as_string($CRLF);
108
 
            print $con $CRLF;
109
 
            print $con substr($content, $start, $len);
 
104
            if ($len > 0) {
 
105
                $resp->header("Accept-Ranges" => "bytes");
 
106
                $resp->header("Content-Length" => $len);
 
107
                $resp->header("Content-Range"
 
108
                    => "bytes $start-$end/$content_len");
 
109
                $resp->header("Keep-Alive" => "timeout=15, max=100");
 
110
                $resp->header("Connection" => "Keep-Alive");
 
111
                $con->send_basic_header(206,
 
112
                    "Partial Content", $resp->protocol);
 
113
                print $con $resp->headers_as_string($CRLF);
 
114
                print $con $CRLF;
 
115
                print $con substr($content, $start, $len);
 
116
            } else {
 
117
                $con->send_basic_header(416, "Range Not Satisfiable",
 
118
                    $resp->protocol);
 
119
                $resp->header("Keep-Alive" => "timeout=15, max=100");
 
120
                $resp->header("Connection" => "Keep-Alive");
 
121
                print $con $CRLF;
 
122
            }
110
123
            next;
111
124
        }
112
125
        # fill in content
 
126
        $content = $self->_substitute_port($content) if defined $content;
113
127
        $resp->content($content);
114
128
        print STDERR "HTTP::Response with content: \n", $resp->as_string if $log;
115
129
    }
133
147
    my $authhdr = $req->header('Authorization');
134
148
 
135
149
    # Have we sent the challenge yet?
136
 
    unless (defined $url_rec->{auth_challenged}
137
 
        && $url_rec->{auth_challenged}) {
 
150
    unless ($url_rec->{auth_challenged} || $url_rec->{auth_no_challenge}) {
138
151
        # Since we haven't challenged yet, we'd better not
139
152
        # have received authentication (for our testing purposes).
140
153
        if ($authhdr) {
155
168
        # failed it.
156
169
        $code = 400;
157
170
        $msg  = "You didn't send auth after I sent challenge";
 
171
        if ($url_rec->{auth_no_challenge}) {
 
172
            $msg = "--auth-no-challenge but no auth sent."
 
173
        }
158
174
    } else {
159
175
        my ($sent_method) = ($authhdr =~ /^(\S+)/g);
160
176
        unless ($sent_method eq $url_rec->{'auth_method'}) {
197
213
    }
198
214
}
199
215
 
 
216
sub verify_request_headers {
 
217
    my ($self, $req, $url_rec) = @_;
 
218
 
 
219
    return 1 unless exists $url_rec->{'request_headers'};
 
220
    for my $hdrname (keys %{$url_rec->{'request_headers'}}) {
 
221
        my $rhdr = $req->header ($hdrname);
 
222
        my $ehdr = $url_rec->{'request_headers'}{$hdrname};
 
223
        unless (defined $rhdr && $rhdr =~ $ehdr) {
 
224
            $rhdr = '' unless defined $rhdr;
 
225
            print STDERR "\n*** Mismatch on $hdrname: $rhdr =~ $ehdr\n";
 
226
            return undef;
 
227
        }
 
228
    }
 
229
 
 
230
    return 1;
 
231
}
 
232
 
 
233
sub _substitute_port {
 
234
    my $self = shift;
 
235
    my $ret = shift;
 
236
    $ret =~ s/{{port}}/$self->sockport/eg;
 
237
    return $ret;
 
238
}
 
239
 
200
240
1;
201
241
 
202
242
# vim: et ts=4 sw=4