402 lines
12 KiB
Perl
402 lines
12 KiB
Perl
#
|
|
# Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License version 2 as
|
|
# published by the Free Software Foundation.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program (see the file COPYING); if not, write to the
|
|
# Free Software Foundation, Inc.,
|
|
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
|
|
#
|
|
################################################################
|
|
#
|
|
# HTTP protocol functions. Also contains file/cpio sender/receiver.
|
|
#
|
|
|
|
package BSHTTP;
|
|
|
|
use Digest::MD5 ();
|
|
|
|
use strict;
|
|
|
|
sub gethead {
|
|
my ($h, $t) = @_;
|
|
|
|
my ($field, $data);
|
|
for (split(/[\r\n]+/, $t)) {
|
|
next if $_ eq '';
|
|
if (/^[ \t]/) {
|
|
next unless defined $field;
|
|
s/^\s*/ /;
|
|
$h->{$field} .= $_;
|
|
} else {
|
|
($field, $data) = split(/\s*:\s*/, $_, 2);
|
|
$field =~ tr/A-Z/a-z/;
|
|
if ($h->{$field} && $h->{$field} ne '') {
|
|
$h->{$field} = $h->{$field}.','.$data;
|
|
} else {
|
|
$h->{$field} = $data;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# read data from socket, do chunk decoding
|
|
# hdr: header data
|
|
# maxl = undef: read as much as you can
|
|
# exact = 1: read maxl data, maxl==undef -> read to eof;
|
|
#
|
|
sub read_data {
|
|
my ($hdr, $maxl, $exact) = @_;
|
|
|
|
my $ret = '';
|
|
local *S = $hdr->{'__socket'};
|
|
if ($hdr->{'transfer-encoding'} && lc($hdr->{'transfer-encoding'}) eq 'chunked') {
|
|
my $cl = $hdr->{'__cl'} || 0;
|
|
if ($cl < 0) {
|
|
die("unexpected EOF\n") if $exact && defined($maxl) && length($ret) < $maxl;
|
|
return $ret;
|
|
}
|
|
my $qu = $hdr->{'__data'};
|
|
while(1) {
|
|
if (defined($maxl) && $maxl <= $cl) {
|
|
while(length($qu) < $maxl) {
|
|
my $r = sysread(S, $qu, 8192, length($qu));
|
|
die("unexpected EOF\n") unless $r;
|
|
}
|
|
$ret .= substr($qu, 0, $maxl);
|
|
$hdr->{'__cl'} = $cl - $maxl;
|
|
$hdr->{'__data'} = substr($qu, $maxl);
|
|
return $ret;
|
|
}
|
|
if ($cl) {
|
|
# no maxl or maxl > cl, read full cl
|
|
while(length($qu) < $cl) {
|
|
my $r = sysread(S, $qu, 8192, length($qu));
|
|
die("unexpected EOF\n") unless $r;
|
|
}
|
|
$ret .= substr($qu, 0, $cl);
|
|
$qu = substr($qu, $cl);
|
|
$maxl -= $cl if defined $maxl;
|
|
$cl = 0;
|
|
if (!defined($maxl) && !$exact) { # no maxl, return every chunk
|
|
$hdr->{'__cl'} = $cl;
|
|
$hdr->{'__data'} = $qu;
|
|
return $ret;
|
|
}
|
|
}
|
|
while ($qu !~ /\r?\n/s) {
|
|
my $r = sysread(S, $qu, 8192, length($qu));
|
|
die("unexpected EOF\n") unless $r;
|
|
}
|
|
if (substr($qu, 0, 1) eq "\n") {
|
|
$qu = substr($qu, 1);
|
|
next;
|
|
}
|
|
if (substr($qu, 0, 2) eq "\r\n") {
|
|
$qu = substr($qu, 2);
|
|
next;
|
|
}
|
|
die("bad CHUNK data: $qu\n") unless $qu =~ /^([0-9a-fA-F]+)/;
|
|
$cl = hex($1);
|
|
die if $cl < 0;
|
|
$qu =~ s/^.*?\r?\n//s;
|
|
if ($cl == 0) {
|
|
$hdr->{'__cl'} = -1; # mark EOF
|
|
die("unexpected EOF\n") if $exact && defined($maxl) && length($ret) < $maxl;
|
|
# read trailer
|
|
$qu = "\r\n$qu";
|
|
while ($qu !~ /\n\r?\n/s) {
|
|
my $r = sysread(S, $qu, 8192, length($qu));
|
|
die("unexpected EOF\n") unless $r;
|
|
}
|
|
$qu =~ /^(.*?)\n\r?\n/;
|
|
gethead($hdr, length($1) >= 2 ? substr($1, 2) : '');
|
|
return $ret;
|
|
}
|
|
}
|
|
} else {
|
|
my $qu = $hdr->{'__data'};
|
|
my $cl = $hdr->{'__cl'};
|
|
$cl = $hdr->{'content-length'} unless defined $cl;
|
|
if (defined($cl) && (!defined($maxl) || $maxl > $cl)) {
|
|
die("unexpected EOF\n") if $exact && defined($maxl);
|
|
$maxl = $cl >= 0 ? $cl : 0;
|
|
}
|
|
while (!defined($maxl) || length($qu) < $maxl) {
|
|
my $m = ($maxl || 0) - length($qu);
|
|
$m = 8192 if $m < 8192;
|
|
my $r = sysread(S, $qu, $m, length($qu));
|
|
if (!$r) {
|
|
die("unexpected EOF\n") if defined($cl) || ($exact && defined($maxl));
|
|
$cl = $maxl = length($qu);
|
|
}
|
|
}
|
|
$cl -= $maxl if defined($cl);
|
|
$ret = substr($qu, 0, $maxl);
|
|
$hdr->{'__cl'} = $cl;
|
|
$hdr->{'__data'} = substr($qu, $maxl);
|
|
return $ret;
|
|
}
|
|
}
|
|
|
|
sub str2hdr {
|
|
my ($str) = @_;
|
|
my $hdr = {
|
|
'__data' => $str,
|
|
'__cl' => length($str),
|
|
};
|
|
return $hdr;
|
|
}
|
|
|
|
sub fd2hdr {
|
|
my ($fd) = @_;
|
|
my $hdr = {
|
|
'__data' => '',
|
|
'__socket' => $fd,
|
|
'__cl' => -s *$fd,
|
|
};
|
|
return $hdr;
|
|
}
|
|
|
|
sub file_receiver {
|
|
my ($hdr, $param) = @_;
|
|
|
|
die("file_receiver: no filename\n") unless defined $param->{'filename'};
|
|
my $fn = $param->{'filename'};
|
|
my $withmd5 = $param->{'withmd5'};
|
|
local *F;
|
|
my $ctx;
|
|
$ctx = Digest::MD5->new if $withmd5;
|
|
open(F, '>', $fn) || die("$fn: $!\n");
|
|
my $size = 0;
|
|
while(1) {
|
|
my $s = read_data($hdr, 8192);
|
|
last if $s eq '';
|
|
(syswrite(F, $s) || 0) == length($s) || die("syswrite: $!\n");
|
|
$size += length($s);
|
|
$ctx->add($s) if $ctx;
|
|
}
|
|
close(F) || die("close: $!\n");
|
|
my $res = {size => $size};
|
|
$res->{'md5'} = $ctx->hexdigest if $ctx;
|
|
return $res;
|
|
}
|
|
|
|
sub cpio_receiver {
|
|
my ($hdr, $param) = @_;
|
|
my @res;
|
|
my $dn = $param->{'directory'};
|
|
my $withmd5 = $param->{'withmd5'};
|
|
local *F;
|
|
while(1) {
|
|
my $cpiohead = read_data($hdr, 110, 1);
|
|
die("cpio: not a 'SVR4 no CRC ascii' cpio\n") unless substr($cpiohead, 0, 6) eq '070701';
|
|
my $mode = hex(substr($cpiohead, 14, 8));
|
|
my $mtime = hex(substr($cpiohead, 46, 8));
|
|
my $size = hex(substr($cpiohead, 54, 8));
|
|
if ($size == 0xffffffff) {
|
|
# build service length extension
|
|
$cpiohead .= read_data($hdr, 16, 1);
|
|
$size = hex(substr($cpiohead, 62, 8)) * 4294967296. + hex(substr($cpiohead, 70, 8));
|
|
substr($cpiohead, 62, 16) = '';
|
|
}
|
|
my $nsize = hex(substr($cpiohead, 94, 8));
|
|
die("ridiculous long filename\n") if $nsize > 8192;
|
|
my $nsizepad = $nsize;
|
|
$nsizepad += 4 - ($nsize + 2 & 3) if $nsize + 2 & 3;
|
|
my $name = read_data($hdr, $nsizepad, 1);
|
|
$name =~ s/\0.*//s;
|
|
$name =~ s/^\.\///s;
|
|
my $sizepad = $size;
|
|
$sizepad += 4 - ($size % 4) if $size % 4;
|
|
last if !$size && $name eq 'TRAILER!!!';
|
|
if ($param->{'acceptsubdirs'} || $param->{'createsubdirs'}) {
|
|
die("cpio filename is illegal: $name\n") if "/$name/" =~ /\/\.{0,2}\//s;
|
|
} else {
|
|
die("cpio filename contains a '/': $name\n") if $name =~ /\//s;
|
|
}
|
|
die("cpio filename is '.' or '..'\n") if $name eq '.' || $name eq '..';
|
|
my $ent = {'name' => $name, 'size' => $size, 'mtime' => $mtime, 'mode' => $mode};
|
|
if ($param->{'accept'}) {
|
|
if (ref($param->{'accept'})) {
|
|
die("illegal file in cpio archive: $name\n") unless $param->{'accept'}->($param, $name, $ent);
|
|
} else {
|
|
die("illegal file in cpio archive: $name\n") unless $name =~ /$param->{'accept'}/;
|
|
}
|
|
}
|
|
if ($param->{'map'}) {
|
|
$ent->{'unmappedname'} = $name;
|
|
if (ref($param->{'map'})) {
|
|
$ent->{'name'} = $name = $param->{'map'}->($param, $name);
|
|
} else {
|
|
$ent->{'name'} = $name = "$param->{'map'}$name";
|
|
}
|
|
}
|
|
if (!defined($name)) {
|
|
# skip entry
|
|
while ($sizepad) {
|
|
my $m = $sizepad > 8192 ? 8192 : $sizepad;
|
|
read_data($hdr, $m, 1);
|
|
$sizepad -= $m;
|
|
}
|
|
next;
|
|
}
|
|
push @res, $ent;
|
|
my $ctx;
|
|
$ctx = Digest::MD5->new if $withmd5;
|
|
if (defined($dn)) {
|
|
my $filename = "$dn/$name";
|
|
if (($mode & 0xf000) == 0x4000 && $param->{'createsubdirs'}) {
|
|
die("directory has non-zero size\n") if $sizepad;
|
|
if (! -d $filename) {
|
|
unlink($filename) unless $param->{'no_unlink'};
|
|
mkdir($filename) || die("mkdir $filename: $!\n");
|
|
}
|
|
} else {
|
|
die("can only unpack plain files from cpio archive, file $name, mode was $mode\n") unless ($mode & 0xf000) == 0x8000;
|
|
unlink($filename) unless $param->{'no_unlink'};
|
|
open(F, '>', $filename) || die("$filename: $!\n");
|
|
}
|
|
} else {
|
|
$ent->{'data'} = '';
|
|
}
|
|
while ($sizepad) {
|
|
my $m = $sizepad > 8192 ? 8192 : $sizepad;
|
|
my $data = read_data($hdr, $m, 1);
|
|
$sizepad -= $m;
|
|
$size -= $m;
|
|
$m += $size if $size < 0;
|
|
if (defined($dn)) {
|
|
(syswrite(F, $data, $m) || 0) == $m || die("syswrite: $!\n");
|
|
} else {
|
|
$ent->{'data'} .= substr($data, 0, $m);
|
|
}
|
|
$ctx->add($size >= 0 ? $data : substr($data, 0, $m)) if $ctx;
|
|
}
|
|
if (defined($dn) && ($mode & 0xf000) != 0x4000) {
|
|
close(F) || die("close: $!\n");
|
|
utime($mtime, $mtime, "$dn/$name");
|
|
}
|
|
$ent->{'md5'} = $ctx->hexdigest if $ctx && ($mode & 0xf000) != 0x4000;
|
|
$param->{'cpiopostfile'}->($param, $ent) if $param->{'cpiopostfile'};
|
|
}
|
|
return \@res;
|
|
}
|
|
|
|
sub swrite {
|
|
my ($sock, $data) = @_;
|
|
local *S = $sock;
|
|
while (length($data)) {
|
|
my $l = syswrite(S, $data, length($data));
|
|
die("socket write: $!\n") unless $l;
|
|
$data = substr($data, $l);
|
|
}
|
|
}
|
|
|
|
sub cpio_sender {
|
|
my ($param, $sock) = @_;
|
|
|
|
my $errors = '';
|
|
local *F;
|
|
my $data;
|
|
for my $file (@{$param->{'cpiofiles'} || []}, {'__errors' => 1}) {
|
|
my @s;
|
|
if ($file->{'error'}) {
|
|
$errors .= "$file->{'name'}: $file->{'error'}\n";
|
|
next;
|
|
}
|
|
if (exists $file->{'filename'}) {
|
|
if (ref($file->{'filename'})) {
|
|
*F = $file->{'filename'};
|
|
} elsif (!open(F, '<', $file->{'filename'})) {
|
|
$errors .= "$file->{'name'}: $file->{'filename'}: $!\n";
|
|
next;
|
|
}
|
|
@s = stat(F);
|
|
} else {
|
|
if ($file->{'__errors'}) {
|
|
next if $errors eq '';
|
|
$file->{'data'} = $errors;
|
|
$file->{'name'} = ".errors";
|
|
}
|
|
$s[7] = length($file->{'data'});
|
|
$s[9] = time;
|
|
}
|
|
my $mode = $file->{'mode'} || 0x81a4;
|
|
$data = sprintf("07070100000000%08x000000000000000000000001", $mode);
|
|
if ($s[7] > 0xffffffff) {
|
|
# build service length extension
|
|
my $top = int($s[7] / 4294967296.);
|
|
$data .= sprintf("%08xffffffff%08x%08x", $s[9], $top, $s[7] - $top * 4294967296.);
|
|
} else {
|
|
$data .= sprintf("%08x%08x", $s[9], $s[7]);
|
|
}
|
|
$data .= "00000000000000000000000000000000";
|
|
$data .= sprintf("%08x", length($file->{'name'}) + 1);
|
|
$data .= "00000000";
|
|
$data .= "$file->{'name'}\0";
|
|
$data .= substr("\0\0\0\0", (length($data) & 3)) if length($data) & 3;
|
|
if (exists $file->{'filename'}) {
|
|
my $l = $s[7];
|
|
my $r = 0;
|
|
while(1) {
|
|
$r = sysread(F, $data, $l > 8192 ? 8192 : $l, length($data)) if $l;
|
|
$data .= substr("\0\0\0\0", ($s[7] % 4)) if $r == $l && ($s[7] % 4) != 0;
|
|
$data = sprintf("%X\r\n", length($data)).$data."\r\n" if $param->{'chunked'};
|
|
swrite($sock, $data);
|
|
$data = '';
|
|
$l -= $r;
|
|
last unless $l;
|
|
}
|
|
die("internal error\n") if $l;
|
|
close F unless ref $file->{'filename'};
|
|
} else {
|
|
$data .= $file->{'data'};
|
|
$data .= substr("\0\0\0\0", (length($data) & 3)) if length($data) & 3;
|
|
$data = sprintf("%X\r\n", length($data)).$data."\r\n" if $param->{'chunked'};
|
|
swrite($sock, $data);
|
|
}
|
|
}
|
|
$data = "07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000b00000000TRAILER!!!\0\0\0\0";
|
|
$data = sprintf("%X\r\n", length($data)).$data."\r\n" if $param->{'chunked'};
|
|
swrite($sock, $data);
|
|
return '';
|
|
}
|
|
|
|
sub file_sender {
|
|
my ($param, $sock) = @_;
|
|
local *F;
|
|
|
|
my $bytes = $param->{'bytes'};
|
|
my $data;
|
|
if (ref($param->{'filename'})) {
|
|
*F = $param->{'filename'};
|
|
} else {
|
|
open(F, '<', $param->{'filename'}) || die("$param->{'filename'}: $!\n")
|
|
}
|
|
while(1) {
|
|
last if defined($bytes) && !$bytes;
|
|
my $r = sysread(F, $data, 8192);
|
|
last unless $r;
|
|
if ($bytes) {
|
|
$data = substr($data, 0, $bytes) if length($data) > $bytes;
|
|
$bytes -= length($data);
|
|
}
|
|
$data = sprintf("%X\r\n", length($data)).$data."\r\n" if $param->{'chunked'};
|
|
swrite($sock, $data);
|
|
}
|
|
close F unless ref $param->{'filename'};
|
|
return '';
|
|
}
|
|
|
|
1;
|