RZ

001: # BlockRetrieval.pl # the actual synthesize algorithm
002:
003: use strict;
004: use LWP::UserAgent ();
005:
006: package BlockRetrieval;
007:
008: ######## ######## ######## ######## ######## ######## ######## ######## ########
009:
010: my $ua = LWP::UserAgent->new( agent => "rgz/0.43" );
011: my $request= HTTP::Request->new(
012:     GET => $GetoptSynthesize::url,
013:     HTTP::Headers->new(
014:         Range => "bytes=0-63",
015:     ),
016: );
017:
018: my $received = 0;
019:
020: sub retrieverange {
021:     $request->headers->header( Range => $_[0] );
022:
023:     my ( $isrange, $boundary, $bf, $remaining, $intermediate );
024:
025:     ######## ######## ######## ######## ######## ######## ######## ########
026:
027:     my $contenthandler = sub {
028:         # debug -- add realistic delays
029:         select( undef, undef, undef, 0.005 ) if $::debug;
030:
031:         if ( not defined $isrange ) {
032:             if ( $_[1]->code() != 206 ) {
033:                 my $lengthheader =  $_[1]->headers->header( Content_length => );
034:                 defined $lengthheader
035:                   or die "Can't get file length from server\n\n";
036:                 $isrange = 0;
037:
038:                 print pack( "N3", 0, $lengthheader, $lengthheader );
039:                 #$::debug and printf STDERR "(0-%i/%i)",
040:                 #       ( $lengthheader - 1, $lengthheader );
041:             }
042:             elsif (
043:                 my $rangeheader = $_[1]->headers->header( Content_range => )
044:             ) {
045:                 my ( $rangefrom, $rangeto, $filesize ) =
046:                   $rangeheader =~ /^bytes (\d+)-(\d+)\/(\d+)$/
047:                   or die "Retrieved malformed content range header\n\n";
048:                 $isrange = 1;
049:
050:                 # transmit half-open half-closed range
051:                 print pack( "N3", $rangefrom, ++$rangeto, $filesize );
052:                 #$::debug and printf STDERR "(%i-%i/%i)",
053:                 #       ( $rangefrom, $rangeto - 1, $filesize );
054:             }
055:             elsif (
056:                 ( $boundary ) = $_[1]->headers->header(
057:                     Content_type =>
058:                 ) =~ /^multipart.+byteranges.*boundary=(\"\S+\"|\S+)/
059:             ) {
060:                 $isrange = 2;
061:                 $bf = '';
062:                 $remaining = 0;
063:                 $intermediate = 0;
064:             }
065:             else {
066:                 die "Unable to retrieve file\n\n";
067:             }
068:         }
069:
070:         if ( $isrange < 2 ) {
071:             $received += length( $_[0] );
072:             print $_[0];
073:             return;
074:         }
075:
076:         for ( $bf .= $_[0]; $bf; ) {
077:             if ( not defined $remaining ) {
078:                 $bf =~ /^--\s*\n$/ and return;
079:                 $bf =~ /\n\s*\n/s or return;
080:                 ( my $header, $bf ) = $bf =~ /^(.*?)\n\s*\n(.*)$/s;
081:                 my ( $rangefrom, $rangeto, $filesize ) = $header
082:                   =~ /Content-range: bytes (\d+)-(\d+)\/(\d+)/
083:                   or die "Retrieved malformed content range header\n\n";
084:
085:                 # transmit intermediate chained = true flag
086:                 if ( $intermediate ) {
087:                     print pack( "N", -1 );
088:                 }
089:                 else {
090:                     $intermediate = 1;
091:                 }
092:
093:                 # transmit half-open half-closed range
094:                 print pack( "N3", $rangefrom, ++$rangeto, $filesize );
095:                 #$::debug and printf STDERR "(%i-%i/%i)",
096:                 #       ( $rangefrom, $rangeto - 1, $filesize );
097:
098:                 $remaining = $rangeto - $rangefrom;
099:             }
100:
101:             if ( $remaining ) {
102:                 my $br = substr( $bf, 0, $remaining, "" );
103:                 {
104:                     my $l = length( $br );
105:                     $received += $l;
106:                     $remaining -= $l;
107:                 }
108:                 print $br;
109:             }
110:
111:             if ( not $remaining ) {
112:                 $bf =~ /^\s*\r?\n--$boundary/s or return;
113:
114:                 $bf =~ s/^\s*\r?\n--$boundary//s;
115:
116:                 undef $remaining;
117:             }
118:         }
119:     };
120:
121:     ######## ######## ######## ######## ######## ######## ######## ########
122:
123:     # $_[1] || $::debug -- add smooth delays with small preferred response size
124:     # $_[1] || $::debug -- add jagged delays with large preferred response size
125:     my $response = $ua->request(
126:         $request, $contenthandler, 
127:         $_[1] || $::debug > 1 ? 100000 : $::debug == 1 ? 1000 : 25000,
128:     );
129:
130:     # transmit intermediate chained = false flag
131:     print pack( "N", 0 );
132:
133:     unless ( $response->is_success ) {
134:         die "HTTP Error ", $response->code,
135:           " ", $response->message, "\n", "Can't retrieve remote rz file\n";
136:     }
137: }
138:
139: ######## ######## ######## ######## ######## ######## ######## ######## ########
140:
141: # BlockRetrieval.pl # the actual synthesize algorithm
142:
143: 1;