Merge pull request #3035 from Vogtinator/pymirror
Rewrite bs_mirrorfull as osclib component
This commit is contained in:
darix
GitHub
commit
29c388e47a
2
.github/workflows/ci-test.yml
vendored
2
.github/workflows/ci-test.yml
vendored
@ -83,7 +83,7 @@ jobs:
|
||||
run: |
|
||||
for f in $(find . -maxdepth 1 -type f -executable -print); do
|
||||
# skip completely broken scripts or those without --help
|
||||
[[ " ./checknewer.py ./repo2fileprovides.py ./openqa-maintenance.py ./docker_publisher.py ./publish_distro ./bs_mirrorfull ./findfileconflicts ./write_repo_susetags_file.pl ./issue-diff.py " =~ "$f" ]] || "$f" --help
|
||||
[[ " ./checknewer.py ./repo2fileprovides.py ./openqa-maintenance.py ./docker_publisher.py ./publish_distro ./findfileconflicts ./write_repo_susetags_file.pl ./issue-diff.py " =~ "$f" ]] || "$f" --help
|
||||
done
|
||||
|
||||
linters:
|
||||
|
||||
@ -108,15 +108,6 @@ Manages bugowner information
|
||||
* Package: openSUSE-release-tools
|
||||
* Usage: ?
|
||||
|
||||
#### bs_mirrorfull
|
||||
|
||||
Mirrors repositories from the build service to a local directory.
|
||||
|
||||
* Souces: [bs_mirrorfull](bs_mirrorfull)
|
||||
* Documentation: --
|
||||
* Package: openSUSE-release-tools
|
||||
* Usage: Used by other tools like `pkglistgen` or `repocheck`
|
||||
|
||||
#### biarchtool
|
||||
|
||||
Manages biarch packages
|
||||
|
||||
2
Makefile
2
Makefile
@ -4,7 +4,7 @@ include Makefile.common
|
||||
|
||||
pkgdata_BINS = $(shell find * -maxdepth 0 -executable -type f)
|
||||
pkgdata_SCRIPTS=$(wildcard *.py *.pl *.sh)
|
||||
pkgdata_SCRIPTS+=bs_mirrorfull findfileconflicts publish_distro
|
||||
pkgdata_SCRIPTS+=findfileconflicts publish_distro
|
||||
pkgdata_DATA+=bs_copy metrics osclib pkglistgen $(wildcard *.pm *.testcase)
|
||||
VERSION = "build-$(shell date +%F)"
|
||||
|
||||
|
||||
@ -1,401 +0,0 @@
|
||||
#
|
||||
# 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;
|
||||
354
bs_copy/BSRPC.pm
354
bs_copy/BSRPC.pm
@ -1,354 +0,0 @@
|
||||
#
|
||||
# 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
|
||||
#
|
||||
################################################################
|
||||
#
|
||||
# Run a HTTP query operation. Single thread only.
|
||||
#
|
||||
|
||||
package BSRPC;
|
||||
|
||||
use Socket;
|
||||
use XML::Structured;
|
||||
use Symbol;
|
||||
use MIME::Base64;
|
||||
use Data::Dumper;
|
||||
|
||||
use BSHTTP;
|
||||
|
||||
use strict;
|
||||
|
||||
our $useragent = 'BSRPC 0.9.1';
|
||||
|
||||
my %hostlookupcache;
|
||||
my %cookiestore; # our session store to keep iChain fast
|
||||
my $tossl;
|
||||
|
||||
my $noproxy;
|
||||
|
||||
sub import {
|
||||
if (grep {$_ eq ':https'} @_) {
|
||||
require BSSSL;
|
||||
$tossl = \&BSSSL::tossl;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
my $tcpproto = getprotobyname('tcp');
|
||||
|
||||
sub urlencode {
|
||||
my $url = $_[0];
|
||||
$url =~ s/([\000-\040<>;\"#\?&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
|
||||
return $url;
|
||||
}
|
||||
|
||||
sub createuri {
|
||||
my ($param, @args) = @_;
|
||||
my $uri = $param->{'uri'};
|
||||
if (!$param->{'verbatim_uri'} && $uri =~ /^(https?:\/\/[^\/]*\/)(.*)$/s) {
|
||||
$uri = $1;
|
||||
$uri .= BSRPC::urlencode($2);
|
||||
}
|
||||
if (@args) {
|
||||
for (@args) {
|
||||
$_ = urlencode($_);
|
||||
s/%3D/=/; # convert first now escaped '=' back
|
||||
}
|
||||
if ($uri =~ /\?/) {
|
||||
$uri .= '&'.join('&', @args);
|
||||
} else {
|
||||
$uri .= '?'.join('&', @args);
|
||||
}
|
||||
}
|
||||
return $uri;
|
||||
}
|
||||
|
||||
sub useproxy {
|
||||
my ($host, $noproxy) = @_;
|
||||
|
||||
# strip leading and tailing whitespace
|
||||
$noproxy =~ s/^\s+//;
|
||||
$noproxy =~ s/\s+$//;
|
||||
# noproxy is a list separated by commas and optional whitespace
|
||||
for (split(/\s*,\s*/, $noproxy)) {
|
||||
return 0 if $host =~ m/(^|\.)$_$/;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub createreq {
|
||||
my ($param, $uri, $proxy, $cookiestore, @xhdrs) = @_;
|
||||
|
||||
my $act = $param->{'request'} || 'GET';
|
||||
if (exists($param->{'socket'})) {
|
||||
my $req = "$act $uri HTTP/1.1\r\n".join("\r\n", @xhdrs)."\r\n\r\n";
|
||||
return ('', undef, undef, $req, undef);
|
||||
}
|
||||
my ($proxyauth, $proxytunnel);
|
||||
die("bad uri: $uri\n") unless $uri =~ /^(https?):\/\/(?:([^\/\@]*)\@)?([^\/:]+)(:\d+)?(\/.*)$/;
|
||||
my ($proto, $auth, $host, $port, $path) = ($1, $2, $3, $4, $5);
|
||||
my $hostport = $port ? "$host$port" : $host;
|
||||
undef $proxy if $proxy && defined($noproxy) && !useproxy($host, $noproxy);
|
||||
if ($proxy) {
|
||||
die("bad proxy uri: $proxy\n") unless "$proxy/" =~ /^(https?):\/\/(?:([^\/\@]*)\@)?([^\/:]+)(:\d+)?(\/.*)$/;
|
||||
($proto, $proxyauth, $host, $port) = ($1, $2, $3, $4);
|
||||
$path = $uri unless $uri =~ /^https:/;
|
||||
}
|
||||
$port = substr($port || ($proto eq 'http' ? ":80" : ":443"), 1);
|
||||
unshift @xhdrs, "Connection: close" unless $param->{'noclose'};
|
||||
unshift @xhdrs, "User-Agent: $useragent" unless !defined($useragent) || grep {/^user-agent:/si} @xhdrs;
|
||||
unshift @xhdrs, "Host: $hostport" unless grep {/^host:/si} @xhdrs;
|
||||
if (defined $auth) {
|
||||
$auth =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
|
||||
unshift @xhdrs, "Authorization: Basic ".encode_base64($auth, '');
|
||||
}
|
||||
if (defined $proxyauth) {
|
||||
$proxyauth =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
|
||||
unshift @xhdrs, "Proxy-Authorization: Basic ".encode_base64($proxyauth, '');
|
||||
}
|
||||
if ($proxy && $uri =~ /^https/) {
|
||||
if ($hostport =~ /:\d+$/) {
|
||||
$proxytunnel = "CONNECT $hostport HTTP/1.1\r\nHost: $hostport\r\n";
|
||||
} else {
|
||||
$proxytunnel = "CONNECT $hostport:443 HTTP/1.1\r\nHost: $hostport:443\r\n";
|
||||
}
|
||||
$proxytunnel .= shift(@xhdrs)."\r\n" if defined $proxyauth;
|
||||
$proxytunnel .= "\r\n";
|
||||
}
|
||||
if ($cookiestore && %$cookiestore) {
|
||||
if ($uri =~ /((:?https?):\/\/(?:([^\/]*)\@)?(?:[^\/:]+)(?::\d+)?)(?:\/.*)$/) {
|
||||
push @xhdrs, map {"Cookie: $_"} @{$cookiestore->{$1} || []};
|
||||
}
|
||||
}
|
||||
my $req = "$act $path HTTP/1.1\r\n".join("\r\n", @xhdrs)."\r\n\r\n";
|
||||
return ($proto, $host, $port, $req, $proxytunnel);
|
||||
}
|
||||
|
||||
#
|
||||
# handled paramters:
|
||||
# timeout
|
||||
# uri
|
||||
# data
|
||||
# headers (array)
|
||||
# chunked
|
||||
# request
|
||||
# verbatim_uri
|
||||
# socket
|
||||
# https
|
||||
# continuation
|
||||
# verbose
|
||||
# sender
|
||||
# async
|
||||
# replyheaders
|
||||
# receiver
|
||||
# ignorestatus
|
||||
# receiverarg
|
||||
# maxredirects
|
||||
# proxy
|
||||
#
|
||||
|
||||
sub rpc {
|
||||
my ($uri, $xmlargs, @args) = @_;
|
||||
|
||||
my $data = '';
|
||||
my @xhdrs;
|
||||
my $chunked;
|
||||
my $param = {'uri' => $uri};
|
||||
|
||||
if (ref($uri) eq 'HASH') {
|
||||
$param = $uri;
|
||||
my $timeout = $param->{'timeout'};
|
||||
if ($timeout) {
|
||||
my %paramcopy = %$param;
|
||||
delete $paramcopy{'timeout'};
|
||||
my $ans;
|
||||
local $SIG{'ALRM'} = sub {alarm(0); die("rpc timeout\n");};
|
||||
eval {
|
||||
eval {
|
||||
alarm($timeout);
|
||||
$ans = rpc(\%paramcopy, $xmlargs, @args);
|
||||
};
|
||||
alarm(0);
|
||||
die($@) if $@;
|
||||
};
|
||||
die($@) if $@;
|
||||
return $ans;
|
||||
}
|
||||
$uri = $param->{'uri'};
|
||||
$data = $param->{'data'};
|
||||
@xhdrs = @{$param->{'headers'} || []};
|
||||
$chunked = 1 if $param->{'chunked'};
|
||||
if (!defined($data) && $param->{'request'} && $param->{'request'} eq 'POST' && @args && grep {/^content-type:\sapplication\/x-www-form-urlencoded$/i} @xhdrs) {
|
||||
for (@args) {
|
||||
$_ = urlencode($_);
|
||||
s/%3D/=/; # convert now escaped = back
|
||||
}
|
||||
$data = join('&', @args);
|
||||
@args = ();
|
||||
}
|
||||
push @xhdrs, "Content-Length: ".length($data) if defined($data) && !ref($data) && !$chunked && !grep {/^content-length:/i} @xhdrs;
|
||||
push @xhdrs, "Transfer-Encoding: chunked" if $chunked;
|
||||
$data = '' unless defined $data;
|
||||
}
|
||||
$uri = createuri($param, @args);
|
||||
my $proxy = $param->{'proxy'};
|
||||
my ($proto, $host, $port, $req, $proxytunnel) = createreq($param, $uri, $proxy, \%cookiestore, @xhdrs);
|
||||
if ($proto eq 'https' || $proxytunnel) {
|
||||
die("https not supported\n") unless $tossl || $param->{'https'};
|
||||
}
|
||||
local *S;
|
||||
if (exists($param->{'socket'})) {
|
||||
*S = $param->{'socket'};
|
||||
} else {
|
||||
if (!$hostlookupcache{$host}) {
|
||||
my $hostaddr = inet_aton($host);
|
||||
die("unknown host '$host'\n") unless $hostaddr;
|
||||
$hostlookupcache{$host} = $hostaddr;
|
||||
}
|
||||
socket(S, PF_INET, SOCK_STREAM, $tcpproto) || die("socket: $!\n");
|
||||
setsockopt(S, SOL_SOCKET, SO_KEEPALIVE, pack("l",1));
|
||||
connect(S, sockaddr_in($port, $hostlookupcache{$host})) || die("connect to $host:$port: $!\n");
|
||||
if ($proxytunnel) {
|
||||
BSHTTP::swrite(\*S, $proxytunnel);
|
||||
my $ans = '';
|
||||
do {
|
||||
die("received truncated answer\n") if !sysread(S, $ans, 1024, length($ans));
|
||||
} while ($ans !~ /\n\r?\n/s);
|
||||
die("bad answer\n") unless $ans =~ s/^HTTP\/\d+?\.\d+?\s+?(\d+[^\r\n]*)/Status: $1/s;
|
||||
my $status = $1;
|
||||
die("proxy tunnel: CONNECT method failed: $status\n") unless $status =~ /^200[^\d]/;
|
||||
}
|
||||
($param->{'https'} || $tossl)->(\*S, $param->{'ssl_keyfile'}, $param->{'ssl_certfile'}, 1) if $proto eq 'https' || $proxytunnel;
|
||||
}
|
||||
if (!$param->{'continuation'}) {
|
||||
if ($param->{'verbose'}) {
|
||||
print "> $_\n" for split("\r\n", $req);
|
||||
#print "> $data\n" unless ref($data);
|
||||
}
|
||||
$req .= "$data" unless ref($data);
|
||||
if ($param->{'sender'}) {
|
||||
$param->{'sender'}->($param, \*S, $req);
|
||||
} else {
|
||||
while(1) {
|
||||
BSHTTP::swrite(\*S, $req);
|
||||
last unless ref $data;
|
||||
$req = &$data($param, \*S);
|
||||
if (!defined($req) || !length($req)) {
|
||||
$req = $data = '';
|
||||
$req = "0\r\n\r\n" if $chunked;
|
||||
next;
|
||||
}
|
||||
$req = sprintf("%X\r\n", length($req)).$req."\r\n" if $chunked;
|
||||
}
|
||||
}
|
||||
if ($param->{'async'}) {
|
||||
my $ret = {};
|
||||
$ret->{'uri'} = $uri;
|
||||
my $fd = gensym;
|
||||
*$fd = \*S;
|
||||
$ret->{'socket'} = $fd;
|
||||
$ret->{'async'} = 1;
|
||||
$ret->{'continuation'} = 1;
|
||||
$ret->{'request'} = $param->{'request'} || 'GET';
|
||||
$ret->{'verbose'} = $param->{'verbose'} if $param->{'verbose'};
|
||||
$ret->{'replyheaders'} = $param->{'replyheaders'} if $param->{'replyheaders'};
|
||||
$ret->{'receiver'} = $param->{'receiver'} if $param->{'receiver'};
|
||||
$ret->{$_} = $param->{$_} for grep {/^receiver:/} keys %$param;
|
||||
$ret->{'receiverarg'} = $xmlargs if $xmlargs;
|
||||
return $ret;
|
||||
}
|
||||
}
|
||||
my $ans = '';
|
||||
do {
|
||||
die("received truncated answer\n") if !sysread(S, $ans, 1024, length($ans));
|
||||
} while ($ans !~ /\n\r?\n/s);
|
||||
die("bad answer\n") unless $ans =~ s/^HTTP\/\d+?\.\d+?\s+?(\d+[^\r\n]*)/Status: $1/s;
|
||||
my $status = $1;
|
||||
$ans =~ /^(.*?)\n\r?\n(.*)$/s;
|
||||
my $headers = $1;
|
||||
$ans = $2;
|
||||
if ($param->{'verbose'}) {
|
||||
print "< $_\n" for split(/\r?\n/, $headers);
|
||||
}
|
||||
my %headers;
|
||||
BSHTTP::gethead(\%headers, $headers);
|
||||
if ($status =~ /^200[^\d]/) {
|
||||
undef $status;
|
||||
} elsif ($status =~ /^302[^\d]/) {
|
||||
# XXX: should we do the redirect if $param->{'ignorestatus'} is defined?
|
||||
close S;
|
||||
die("error: no redirects allowed\n") unless defined $param->{'maxredirects'};
|
||||
die("error: status 302 but no 'location' header found\n") unless exists $headers{'location'};
|
||||
die("error: max number of redirects reached\n") if $param->{'maxredirects'} < 1;
|
||||
my %myparam = %$param;
|
||||
$myparam{'uri'} = $headers{'location'};
|
||||
$myparam{'maxredirects'} = $param->{'maxredirects'} - 1;
|
||||
return rpc(\%myparam, $xmlargs, @args);
|
||||
} else {
|
||||
#if ($param->{'verbose'}) {
|
||||
# 1 while sysread(S, $ans, 1024, length($ans));
|
||||
# print "< $ans\n";
|
||||
#}
|
||||
if ($status =~ /^(\d+) +(.*?)$/) {
|
||||
die("$1 remote error: $2\n") unless $param->{'ignorestatus'};
|
||||
} else {
|
||||
die("remote error: $status\n") unless $param->{'ignorestatus'};
|
||||
}
|
||||
}
|
||||
if ($headers{'set-cookie'} && $param->{'uri'}) {
|
||||
my @cookie = split(',', $headers{'set-cookie'});
|
||||
s/;.*// for @cookie;
|
||||
if ($param->{'uri'} =~ /((:?https?):\/\/(?:([^\/]*)\@)?(?:[^\/:]+)(?::\d+)?)(?:\/.*)$/) {
|
||||
my %cookie = map {$_ => 1} @cookie;
|
||||
push @cookie, grep {!$cookie{$_}} @{$cookiestore{$1} || []};
|
||||
splice(@cookie, 10) if @cookie > 10;
|
||||
$cookiestore{$1} = \@cookie;
|
||||
}
|
||||
}
|
||||
if (($param->{'request'} || '') eq 'HEAD') {
|
||||
close S;
|
||||
${$param->{'replyheaders'}} = \%headers if $param->{'replyheaders'};
|
||||
return \%headers;
|
||||
}
|
||||
$headers{'__socket'} = \*S;
|
||||
$headers{'__data'} = $ans;
|
||||
my $receiver;
|
||||
$receiver = $param->{'receiver:'.lc($headers{'content-type'} || '')};
|
||||
$receiver ||= $param->{'receiver'};
|
||||
$xmlargs ||= $param->{'receiverarg'};
|
||||
if ($receiver) {
|
||||
$ans = $receiver->(\%headers, $param, $xmlargs);
|
||||
$xmlargs = undef;
|
||||
} else {
|
||||
$ans = BSHTTP::read_data(\%headers, undef, 1);
|
||||
}
|
||||
close S;
|
||||
delete $headers{'__socket'};
|
||||
delete $headers{'__data'};
|
||||
${$param->{'replyheaders'}} = \%headers if $param->{'replyheaders'};
|
||||
#if ($param->{'verbose'}) {
|
||||
# print "< $ans\n";
|
||||
#}
|
||||
if ($xmlargs) {
|
||||
die("answer is not xml\n") if $ans !~ /<.*?>/s;
|
||||
my $res = XMLin($xmlargs, $ans);
|
||||
return $res;
|
||||
}
|
||||
return $ans;
|
||||
}
|
||||
|
||||
1;
|
||||
140
bs_copy/BSSSL.pm
140
bs_copy/BSSSL.pm
@ -1,140 +0,0 @@
|
||||
#
|
||||
# Copyright (c) 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
|
||||
#
|
||||
################################################################
|
||||
#
|
||||
# SSL Socket wrapper. Like Net::SSLeay::Handle, but can tie
|
||||
# inplace and also supports servers. Plus, it uses the more useful
|
||||
# Net::SSLeay::read instead of Net::SSLeay::ssl_read_all.
|
||||
#
|
||||
|
||||
package BSSSL;
|
||||
|
||||
use Socket;
|
||||
use Net::SSLeay;
|
||||
|
||||
use strict;
|
||||
|
||||
my $sslctx;
|
||||
|
||||
sub initctx {
|
||||
my ($keyfile, $certfile) = @_;
|
||||
Net::SSLeay::load_error_strings();
|
||||
Net::SSLeay::SSLeay_add_ssl_algorithms();
|
||||
Net::SSLeay::randomize();
|
||||
$sslctx = Net::SSLeay::CTX_new() or die("CTX_new failed!\n");
|
||||
Net::SSLeay::CTX_set_options($sslctx, &Net::SSLeay::OP_ALL);
|
||||
if ($keyfile) {
|
||||
Net::SSLeay::CTX_use_RSAPrivateKey_file($sslctx, $keyfile, &Net::SSLeay::FILETYPE_PEM) || die("RSAPrivateKey $keyfile failed\n");
|
||||
}
|
||||
if ($certfile) {
|
||||
Net::SSLeay::CTX_use_certificate_file($sslctx, $certfile, &Net::SSLeay::FILETYPE_PEM) || die("certificate $keyfile failed\n");
|
||||
}
|
||||
}
|
||||
|
||||
sub freectx {
|
||||
Net::SSLeay::CTX_free($sslctx);
|
||||
undef $sslctx;
|
||||
}
|
||||
|
||||
sub tossl {
|
||||
local *S = $_[0];
|
||||
tie(*S, 'BSSSL', @_);
|
||||
}
|
||||
|
||||
sub TIEHANDLE {
|
||||
my ($self, $socket, $keyfile, $certfile, $forceconnect) = @_;
|
||||
|
||||
initctx() unless $sslctx;
|
||||
my $ssl = Net::SSLeay::new($sslctx) or die("SSL_new failed\n");
|
||||
Net::SSLeay::set_fd($ssl, fileno($socket));
|
||||
if ($keyfile) {
|
||||
Net::SSLeay::use_RSAPrivateKey_file($ssl, $keyfile, &Net::SSLeay::FILETYPE_PEM) || die("RSAPrivateKey $keyfile failed\n");
|
||||
}
|
||||
if ($certfile) {
|
||||
Net::SSLeay::use_certificate_file($ssl, $certfile, &Net::SSLeay::FILETYPE_PEM) || die("certificate $certfile failed\n");
|
||||
}
|
||||
if (defined($keyfile) && !$forceconnect) {
|
||||
Net::SSLeay::accept($ssl) == 1 || die("SSL_accept\n");
|
||||
} else {
|
||||
Net::SSLeay::connect($ssl) || die("SSL_connect");
|
||||
}
|
||||
return bless [$ssl, $socket];
|
||||
}
|
||||
|
||||
sub PRINT {
|
||||
my $sslr = shift;
|
||||
my $r = 0;
|
||||
for my $msg (@_) {
|
||||
next unless defined $msg;
|
||||
$r = Net::SSLeay::write($sslr->[0], $msg) or last;
|
||||
}
|
||||
return $r;
|
||||
}
|
||||
|
||||
sub READLINE {
|
||||
my ($sslr) = @_;
|
||||
return Net::SSLeay::ssl_read_until($sslr->[0]);
|
||||
}
|
||||
|
||||
sub READ {
|
||||
my ($sslr, undef, $len, $offset) = @_;
|
||||
my $buf = \$_[1];
|
||||
my $r = Net::SSLeay::read($sslr->[0], $len);
|
||||
return undef unless defined $r;
|
||||
return length($$buf = $r) unless defined $offset;
|
||||
my $bl = length($$buf);
|
||||
$$buf .= chr(0) x ($offset - $bl) if $offset > $bl;
|
||||
substr($$buf, $offset) = $r;
|
||||
return length($r);
|
||||
}
|
||||
|
||||
sub WRITE {
|
||||
my ($sslr, $buf, $len, $offset) = @_;
|
||||
return $len unless $len;
|
||||
return Net::SSLeay::write($sslr->[0], substr($buf, $offset || 0, $len)) ? $len : undef;
|
||||
}
|
||||
|
||||
sub FILENO {
|
||||
my ($sslr) = @_;
|
||||
return Net::SSLeay::get_fd($sslr->[0]);
|
||||
}
|
||||
|
||||
sub CLOSE {
|
||||
my ($sslr) = @_;
|
||||
if (tied($sslr->[1]) && tied($sslr->[1]) eq $sslr) {
|
||||
untie($sslr->[1]);
|
||||
close($sslr->[1]);
|
||||
} else {
|
||||
Net::SSLeay::free($sslr->[0]);
|
||||
undef $sslr->[0];
|
||||
}
|
||||
undef $sslr->[1];
|
||||
}
|
||||
|
||||
sub UNTIE {
|
||||
my ($sslr) = @_;
|
||||
Net::SSLeay::free($sslr->[0]);
|
||||
undef $sslr->[0];
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
my ($sslr) = @_;
|
||||
UNTIE($sslr) if $sslr && $sslr->[0];
|
||||
}
|
||||
|
||||
1;
|
||||
@ -1,593 +0,0 @@
|
||||
#
|
||||
# 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
|
||||
#
|
||||
################################################################
|
||||
#
|
||||
# collection of useful functions
|
||||
#
|
||||
|
||||
package BSUtil;
|
||||
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw{writexml writestr readxml readstr ls mkdir_p xfork str2utf8 data2utf8 str2utf8xml data2utf8xml};
|
||||
|
||||
use XML::Structured;
|
||||
use POSIX;
|
||||
use Fcntl qw(:DEFAULT :flock);
|
||||
use Encode;
|
||||
use Storable ();
|
||||
use IO::Handle;
|
||||
|
||||
use strict;
|
||||
|
||||
our $fdatasync_before_rename;
|
||||
|
||||
sub set_fdatasync_before_rename {
|
||||
$fdatasync_before_rename = 1;
|
||||
if (!defined(&File::Sync::fdatasync_fd)) {
|
||||
eval {
|
||||
require File::Sync;
|
||||
};
|
||||
warn($@) if $@;
|
||||
*File::Sync::fdatasync_fd = sub {} unless defined &File::Sync::fdatasync_fd;
|
||||
}
|
||||
}
|
||||
|
||||
sub do_fdatasync {
|
||||
my ($fd) = @_;
|
||||
set_fdatasync_before_rename() unless defined &File::Sync::fdatasync_fd;
|
||||
File::Sync::fdatasync_fd($fd);
|
||||
}
|
||||
|
||||
sub writexml {
|
||||
my ($fn, $fnf, $dd, $dtd) = @_;
|
||||
my $d = XMLout($dtd, $dd);
|
||||
local *F;
|
||||
open(F, '>', $fn) || die("$fn: $!\n");
|
||||
(syswrite(F, $d) || 0) == length($d) || die("$fn write: $!\n");
|
||||
do_fdatasync(fileno(F)) if defined($fnf) && $fdatasync_before_rename;
|
||||
close(F) || die("$fn close: $!\n");
|
||||
return unless defined $fnf;
|
||||
$! = 0;
|
||||
rename($fn, $fnf) || die("rename $fn $fnf: $!\n");
|
||||
}
|
||||
|
||||
sub writestr {
|
||||
my ($fn, $fnf, $d) = @_;
|
||||
local *F;
|
||||
open(F, '>', $fn) || die("$fn: $!\n");
|
||||
if (length($d)) {
|
||||
(syswrite(F, $d) || 0) == length($d) || die("$fn write: $!\n");
|
||||
}
|
||||
do_fdatasync(fileno(F)) if defined($fnf) && $fdatasync_before_rename;
|
||||
close(F) || die("$fn close: $!\n");
|
||||
return unless defined $fnf;
|
||||
rename($fn, $fnf) || die("rename $fn $fnf: $!\n");
|
||||
}
|
||||
|
||||
sub appendstr {
|
||||
my ($fn, $d) = @_;
|
||||
local *F;
|
||||
open(F, '>>', $fn) || die("$fn: $!\n");
|
||||
if (length($d)) {
|
||||
(syswrite(F, $d) || 0) == length($d) || die("$fn write: $!\n");
|
||||
}
|
||||
close(F) || die("$fn close: $!\n");
|
||||
}
|
||||
|
||||
sub readstr {
|
||||
my ($fn, $nonfatal) = @_;
|
||||
local *F;
|
||||
if (!open(F, '<', $fn)) {
|
||||
die("$fn: $!\n") unless $nonfatal;
|
||||
return undef;
|
||||
}
|
||||
my $d = '';
|
||||
1 while sysread(F, $d, 8192, length($d));
|
||||
close F;
|
||||
return $d;
|
||||
}
|
||||
|
||||
sub readxml {
|
||||
my ($fn, $dtd, $nonfatal) = @_;
|
||||
my $d = readstr($fn, $nonfatal);
|
||||
return $d unless defined $d;
|
||||
if ($d !~ /<.*?>/s) {
|
||||
die("$fn: not xml\n") unless $nonfatal;
|
||||
return undef;
|
||||
}
|
||||
return XMLin($dtd, $d) unless $nonfatal;
|
||||
eval { $d = XMLin($dtd, $d); };
|
||||
return $@ ? undef : $d;
|
||||
}
|
||||
|
||||
sub fromxml {
|
||||
my ($d, $dtd, $nonfatal) = @_;
|
||||
return XMLin($dtd, $d) unless $nonfatal;
|
||||
eval { $d = XMLin($dtd, $d); };
|
||||
return $@ ? undef : $d;
|
||||
}
|
||||
|
||||
sub toxml {
|
||||
my ($d, $dtd) = @_;
|
||||
return XMLout($dtd, $d);
|
||||
}
|
||||
|
||||
sub touch($) {
|
||||
my ($file) = @_;
|
||||
if (-e $file) {
|
||||
utime(time, time, $file);
|
||||
} else {
|
||||
# create new file, mtime is anyway current
|
||||
local *F;
|
||||
open(F, '>>', $file) || die("$file: $!\n");
|
||||
close(F) || die("$file close: $!\n");
|
||||
}
|
||||
}
|
||||
|
||||
sub ls {
|
||||
local *D;
|
||||
opendir(D, $_[0]) || return ();
|
||||
my @r = grep {$_ ne '.' && $_ ne '..'} readdir(D);
|
||||
closedir D;
|
||||
return @r;
|
||||
}
|
||||
|
||||
sub mkdir_p {
|
||||
my ($dir) = @_;
|
||||
|
||||
return 1 if -d $dir;
|
||||
my $pdir;
|
||||
if ($dir =~ /^(.+)\//) {
|
||||
$pdir = $1;
|
||||
mkdir_p($pdir) || return undef;
|
||||
}
|
||||
while (!mkdir($dir, 0777)) {
|
||||
my $e = $!;
|
||||
return 1 if -d $dir;
|
||||
if (defined($pdir) && ! -d $pdir) {
|
||||
mkdir_p($pdir) || return undef;
|
||||
next;
|
||||
}
|
||||
$! = $e;
|
||||
warn("mkdir: $dir: $!\n");
|
||||
return undef;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
# calls mkdir_p and changes ownership of the created directory to the
|
||||
# supplied user and group if provided.
|
||||
sub mkdir_p_chown {
|
||||
my ($dir, $user, $group) = @_;
|
||||
|
||||
if (!(-d $dir)) {
|
||||
mkdir_p($dir) || return undef;
|
||||
}
|
||||
return 1 unless defined($user) || defined($group);
|
||||
|
||||
$user = -1 unless defined $user;
|
||||
$group = -1 unless defined $group;
|
||||
|
||||
if ($user !~ /^-?\d+$/ && !($user = getpwnam($user))) {
|
||||
warn "user $user unknown\n"; return undef
|
||||
}
|
||||
if ($group !~ /^-?\d+$/ && !($group = getgrnam($group))) {
|
||||
warn "group $group unknown\n"; return undef
|
||||
}
|
||||
|
||||
my @s = stat($dir);
|
||||
if ($s[4] != $user || $s[5] != $group) {
|
||||
if (!chown $user, $group, $dir) {
|
||||
warn "failed to chown $dir to $user:$group\n"; return undef;
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub drop_privs_to {
|
||||
my ($user, $group) = @_;
|
||||
|
||||
if (defined($group)) {
|
||||
$group = getgrnam($group) unless $group =~ /^\d+$/;
|
||||
die("unknown group\n") unless defined $group;
|
||||
if ($) != $group || $( != $group) {
|
||||
($), $() = ($group, $group);
|
||||
die("setgid: $!\n") if $) != $group;
|
||||
}
|
||||
}
|
||||
if (defined($user)) {
|
||||
$user = getpwnam($user) unless $user =~ /^\d+$/;
|
||||
die("unknown user\n") unless defined $user;
|
||||
if ($> != $user || $< != $user) {
|
||||
($>, $<) = ($user, $user);
|
||||
die("setuid: $!\n") if $> != $user;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub cleandir {
|
||||
my ($dir) = @_;
|
||||
|
||||
my $ret = 1;
|
||||
return 1 unless -d $dir;
|
||||
for my $c (ls($dir)) {
|
||||
if (! -l "$dir/$c" && -d _) {
|
||||
cleandir("$dir/$c");
|
||||
$ret = undef unless rmdir("$dir/$c");
|
||||
} else {
|
||||
$ret = undef unless unlink("$dir/$c");
|
||||
}
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub linktree {
|
||||
my ($from, $to) = @_;
|
||||
return unless -d $from;
|
||||
mkdir_p($to);
|
||||
my @todo = sort(ls($from));
|
||||
while (@todo) {
|
||||
my $f = shift @todo;
|
||||
if (! -l "$from/$f" && -d _) {
|
||||
mkdir_p("$to/$f");
|
||||
unshift @todo, map {"$f/$_"} ls("$from/$f");
|
||||
} else {
|
||||
link("$from/$f", "$to/$f") || die("link $from/$f $to/$f: $!\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub treeinfo {
|
||||
my ($dir) = @_;
|
||||
my @info;
|
||||
my @todo = sort(ls($dir));
|
||||
while (@todo) {
|
||||
my $f = shift @todo;
|
||||
my @s = lstat("$dir/$f");
|
||||
next unless @s;
|
||||
if (-d _) {
|
||||
push @info, "$f";
|
||||
unshift @todo, map {"$f/$_"} ls("$dir/$f");
|
||||
} else {
|
||||
push @info, "$f $s[9]/$s[7]/$s[1]";
|
||||
}
|
||||
}
|
||||
return \@info;
|
||||
}
|
||||
|
||||
sub xfork {
|
||||
my $pid;
|
||||
while (1) {
|
||||
$pid = fork();
|
||||
last if defined $pid;
|
||||
die("fork: $!\n") if $! != POSIX::EAGAIN;
|
||||
sleep(5);
|
||||
}
|
||||
return $pid;
|
||||
}
|
||||
|
||||
sub cp {
|
||||
my ($from, $to, $tof) = @_;
|
||||
local *F;
|
||||
local *T;
|
||||
open(F, '<', $from) || die("$from: $!\n");
|
||||
open(T, '>', $to) || die("$to: $!\n");
|
||||
my $buf;
|
||||
while (sysread(F, $buf, 8192)) {
|
||||
(syswrite(T, $buf) || 0) == length($buf) || die("$to write: $!\n");
|
||||
}
|
||||
close(F);
|
||||
close(T) || die("$to: $!\n");
|
||||
if (defined($tof)) {
|
||||
rename($to, $tof) || die("rename $to $tof: $!\n");
|
||||
}
|
||||
}
|
||||
|
||||
sub checkutf8 {
|
||||
my ($oct) = @_;
|
||||
Encode::_utf8_off($oct);
|
||||
return 1 unless defined $oct;
|
||||
return 1 unless $oct =~ /[\200-\377]/;
|
||||
eval {
|
||||
Encode::_utf8_on($oct);
|
||||
encode('UTF-8', $oct, Encode::FB_CROAK);
|
||||
};
|
||||
return $@ ? 0 : 1;
|
||||
}
|
||||
|
||||
sub str2utf8 {
|
||||
my ($oct) = @_;
|
||||
return $oct unless defined $oct;
|
||||
return $oct unless $oct =~ /[^\011\012\015\040-\176]/s;
|
||||
eval {
|
||||
Encode::_utf8_on($oct);
|
||||
$oct = encode('UTF-8', $oct, Encode::FB_CROAK);
|
||||
};
|
||||
if ($@) {
|
||||
# assume iso-8859-1
|
||||
eval {
|
||||
Encode::_utf8_off($oct);
|
||||
$oct = encode('UTF-8', $oct, Encode::FB_CROAK);
|
||||
};
|
||||
if ($@) {
|
||||
Encode::_utf8_on($oct);
|
||||
$oct = encode('UTF-8', $oct, Encode::FB_XMLCREF);
|
||||
}
|
||||
}
|
||||
Encode::_utf8_off($oct); # just in case...
|
||||
return $oct;
|
||||
}
|
||||
|
||||
sub data2utf8 {
|
||||
my ($d) = @_;
|
||||
if (ref($d) eq 'ARRAY') {
|
||||
for my $dd (@$d) {
|
||||
if (ref($dd) eq '') {
|
||||
$dd = str2utf8($dd);
|
||||
} else {
|
||||
data2utf8($dd);
|
||||
}
|
||||
}
|
||||
} elsif (ref($d) eq 'HASH') {
|
||||
for my $dd (keys %$d) {
|
||||
if (ref($d->{$dd}) eq '') {
|
||||
$d->{$dd} = str2utf8($d->{$dd});
|
||||
} else {
|
||||
data2utf8($d->{$dd});
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub str2utf8xml {
|
||||
my ($oct) = @_;
|
||||
return $oct unless defined $oct;
|
||||
return $oct unless $oct =~ /[^\011\012\015\040-\176]/s;
|
||||
$oct = str2utf8($oct);
|
||||
Encode::_utf8_on($oct);
|
||||
# xml does not accept all utf8 chars, escape the illegal
|
||||
$oct =~ s/([\000-\010\013\014\016-\037\177])/sprintf("&#x%x;",ord($1))/sge;
|
||||
$oct =~ s/([\x{d800}-\x{dfff}\x{fffe}\x{ffff}])/sprintf("&#x%x;",ord($1))/sge;
|
||||
Encode::_utf8_off($oct);
|
||||
return $oct;
|
||||
}
|
||||
|
||||
sub data2utf8xml {
|
||||
my ($d) = @_;
|
||||
if (ref($d) eq 'ARRAY') {
|
||||
for my $dd (@$d) {
|
||||
if (ref($dd) eq '') {
|
||||
$dd = str2utf8xml($dd);
|
||||
} else {
|
||||
data2utf8xml($dd);
|
||||
}
|
||||
}
|
||||
} elsif (ref($d) eq 'HASH') {
|
||||
for my $dd (keys %$d) {
|
||||
if (ref($d->{$dd}) eq '') {
|
||||
$d->{$dd} = str2utf8xml($d->{$dd});
|
||||
} else {
|
||||
data2utf8xml($d->{$dd});
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub waituntilgone {
|
||||
my ($fn, $timeout) = @_;
|
||||
while (1) {
|
||||
return 1 unless -e $fn;
|
||||
return 0 if defined($timeout) && $timeout <= 0;
|
||||
select(undef, undef, undef, .1);
|
||||
$timeout -= .1 if defined $timeout;
|
||||
}
|
||||
}
|
||||
|
||||
sub lockopen {
|
||||
my ($fg, $op, $fn, $nonfatal) = @_;
|
||||
|
||||
local *F = $fg;
|
||||
while (1) {
|
||||
if (!open(F, $op, $fn)) {
|
||||
return undef if $nonfatal;
|
||||
die("$fn: $!\n");
|
||||
}
|
||||
flock(F, LOCK_EX) || die("flock $fn: $!\n");
|
||||
my @s = stat(F);
|
||||
return 1 if @s && $s[3];
|
||||
close F;
|
||||
}
|
||||
}
|
||||
|
||||
sub lockcheck {
|
||||
my ($op, $fn) = @_;
|
||||
local *F;
|
||||
while (1) {
|
||||
if (!open(F, $op, $fn)) {
|
||||
return -1;
|
||||
}
|
||||
if (!flock(F, LOCK_EX | LOCK_NB)) {
|
||||
close(F);
|
||||
return 0;
|
||||
}
|
||||
my @s = stat(F);
|
||||
close F;
|
||||
return 1 if @s && $s[3];
|
||||
}
|
||||
}
|
||||
|
||||
sub lockopenxml {
|
||||
my ($fg, $op, $fn, $dtd, $nonfatal) = @_;
|
||||
if (!lockopen($fg, $op, $fn, $nonfatal)) {
|
||||
die("$fn: $!\n") unless $nonfatal;
|
||||
return undef;
|
||||
}
|
||||
my $d = readxml($fn, $dtd, $nonfatal);
|
||||
if (!$d) {
|
||||
local *F = $fg;
|
||||
close F;
|
||||
}
|
||||
return $d;
|
||||
}
|
||||
|
||||
sub lockcreatexml {
|
||||
my ($fg, $fn, $fnf, $dd, $dtd) = @_;
|
||||
|
||||
local *F = $fg;
|
||||
writexml($fn, undef, $dd, $dtd);
|
||||
open(F, '<', $fn) || die("$fn: $!\n");
|
||||
flock(F, LOCK_EX | LOCK_NB) || die("lock: $!\n");
|
||||
if (!link($fn, $fnf)) {
|
||||
unlink($fn);
|
||||
close F;
|
||||
return undef;
|
||||
}
|
||||
unlink($fn);
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub isotime {
|
||||
my ($t) = @_;
|
||||
my @lt = localtime($t || time());
|
||||
return sprintf "%04d-%02d-%02d %02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0];
|
||||
}
|
||||
|
||||
# XXX: does that really belong here?
|
||||
#
|
||||
# Algorithm:
|
||||
# each enable/disable has a score:
|
||||
# +1 if it's a disable
|
||||
# +2 if the arch matches
|
||||
# +4 if the repo matches
|
||||
#
|
||||
sub enabled {
|
||||
my ($repoid, $disen, $default, $arch) = @_;
|
||||
|
||||
# filter matching elements, check for shortcuts
|
||||
return $default unless $disen;
|
||||
my @dis = grep { (!defined($_->{'arch'}) || $_->{'arch'} eq $arch) &&
|
||||
(!defined($_->{'repository'}) || $_->{'repository'} eq $repoid)
|
||||
} @{$disen->{'disable'} || []};
|
||||
return 1 if !@dis && $default;
|
||||
my @ena = grep { (!defined($_->{'arch'}) || $_->{'arch'} eq $arch) &&
|
||||
(!defined($_->{'repository'}) || $_->{'repository'} eq $repoid)
|
||||
} @{$disen->{'enable'} || []};
|
||||
return @dis ? 0 : $default unless @ena;
|
||||
return @ena ? 1 : $default unless @dis;
|
||||
|
||||
# have @dis and @ena, need to do score thing...
|
||||
my $disscore = 0;
|
||||
for (@dis) {
|
||||
my $score = 1;
|
||||
$score += 2 if defined($_->{'arch'});
|
||||
$score += 4 if defined($_->{'repository'});
|
||||
if ($score > $disscore) {
|
||||
return 0 if $score == 7; # can't max this!
|
||||
$disscore = $score;
|
||||
}
|
||||
}
|
||||
my $enascore = 0;
|
||||
for (@ena) {
|
||||
my $score = 0;
|
||||
$score += 2 if defined($_->{'arch'});
|
||||
$score += 4 if defined($_->{'repository'});
|
||||
if ($score > $enascore) {
|
||||
return 1 if $enascore == 6; # can't max this!
|
||||
$enascore = $score;
|
||||
}
|
||||
}
|
||||
return $enascore > $disscore ? 1 : 0;
|
||||
}
|
||||
|
||||
sub store {
|
||||
my ($fn, $fnf, $dd) = @_;
|
||||
if ($fdatasync_before_rename && defined($fnf)) {
|
||||
local *F;
|
||||
open(F, '>', $fn) || die("$fn: $!\n");
|
||||
if (!Storable::nstore_fd($dd, \*F)) {
|
||||
die("nstore_fd $fn: $!\n");
|
||||
}
|
||||
(\*F)->flush();
|
||||
do_fdatasync(fileno(F));
|
||||
close(F) || die("$fn close: $!\n");
|
||||
} else {
|
||||
if (!Storable::nstore($dd, $fn)) {
|
||||
die("nstore $fn: $!\n");
|
||||
}
|
||||
}
|
||||
return unless defined $fnf;
|
||||
$! = 0;
|
||||
rename($fn, $fnf) || die("rename $fn $fnf: $!\n");
|
||||
}
|
||||
|
||||
sub retrieve {
|
||||
my ($fn, $nonfatal) = @_;
|
||||
my $dd;
|
||||
if (!$nonfatal) {
|
||||
$dd = ref($fn) ? Storable::fd_retrieve($fn) : Storable::retrieve($fn);
|
||||
die("retrieve $fn: $!\n") unless $dd;
|
||||
} else {
|
||||
eval {
|
||||
$dd = ref($fn) ? Storable::fd_retrieve($fn) : Storable::retrieve($fn);
|
||||
};
|
||||
if (!$dd && $nonfatal == 2) {
|
||||
if ($@) {
|
||||
warn($@);
|
||||
} else {
|
||||
warn("retrieve $fn: $!\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
return $dd;
|
||||
}
|
||||
|
||||
sub ping {
|
||||
my ($pingfile) = @_;
|
||||
local *F;
|
||||
if (sysopen(F, $pingfile, POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
|
||||
syswrite(F, 'x');
|
||||
close(F);
|
||||
}
|
||||
}
|
||||
|
||||
sub restartexit {
|
||||
my ($arg, $name, $runfile, $pingfile) = @_;
|
||||
return unless $arg;
|
||||
if ($arg eq '--stop' || $arg eq '--exit') {
|
||||
if (!(-e "$runfile.lock") || lockcheck('>>', "$runfile.lock")) {
|
||||
print "$name not running.\n";
|
||||
exit 0;
|
||||
}
|
||||
print "exiting $name...\n";
|
||||
BSUtil::touch("$runfile.exit");
|
||||
ping($pingfile) if $pingfile;
|
||||
BSUtil::waituntilgone("$runfile.exit");
|
||||
exit(0);
|
||||
}
|
||||
if ($ARGV[0] eq '--restart') {
|
||||
die("$name not running.\n") if !(-e "$runfile.lock") || BSUtil::lockcheck('>>', "$runfile.lock");
|
||||
print "restarting $name...\n";
|
||||
BSUtil::touch("$runfile.restart");
|
||||
ping($pingfile) if $pingfile;
|
||||
BSUtil::waituntilgone("$runfile.restart");
|
||||
exit(0);
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
1671
bs_copy/BSXML.pm
1671
bs_copy/BSXML.pm
File diff suppressed because it is too large
Load Diff
@ -1,532 +0,0 @@
|
||||
|
||||
package XML::Structured;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(XMLin XMLinfile XMLout);
|
||||
$VERSION = '1.0';
|
||||
|
||||
use XML::Parser;
|
||||
use Encode;
|
||||
|
||||
use strict;
|
||||
|
||||
our $bytes;
|
||||
|
||||
sub import {
|
||||
$bytes = 1 if grep {$_ eq ':bytes'} @_;
|
||||
__PACKAGE__->export_to_level(1, grep {$_ ne ':bytes'} @_);
|
||||
}
|
||||
|
||||
sub _workin {
|
||||
my ($how, $out, $ain, @in) = @_;
|
||||
my @how = @$how;
|
||||
my $am = shift @how;
|
||||
|
||||
my %known = map {ref($_) ? (!@$_ ? () : (ref($_->[0]) ? $_->[0]->[0] : $_->[0] => $_)) : ($_=> $_)} @how;
|
||||
for my $a (keys %$ain) {
|
||||
die("unknown attribute: $a\n") unless $known{$a};
|
||||
if (ref($known{$a})) {
|
||||
die("attribute '$a' must be element\n") if @{$known{$a}} > 1 || ref($known{$a}->[0]);
|
||||
push @{$out->{$a}}, $ain->{$a};
|
||||
} else {
|
||||
die("attribute '$a' must be singleton\n") if exists $out->{$a};
|
||||
$out->{$a} = $ain->{$a};
|
||||
Encode::_utf8_off($out->{$a}) if $bytes;
|
||||
}
|
||||
}
|
||||
while (@in) {
|
||||
my ($e, $v) = splice(@in, 0, 2);
|
||||
my $ke = $known{$e};
|
||||
if ($e eq '0') {
|
||||
next if $v =~ /^\s*$/s;
|
||||
die("element '$am' contains content\n") unless $known{'_content'};
|
||||
Encode::_utf8_off($v) if $bytes;
|
||||
$v =~ s/\s+$/ /s;
|
||||
$v =~ s/^\s+/ /s;
|
||||
if (exists $out->{'_content'}) {
|
||||
$out->{'_content'} =~ s/ $//s if $v =~ /^ /s;
|
||||
$out->{'_content'} .= $v;
|
||||
} else {
|
||||
$out->{'_content'} = $v;
|
||||
}
|
||||
next;
|
||||
}
|
||||
if (!$ke && $known{''}) {
|
||||
$ke = $known{''};
|
||||
$v = [{}, $e, $v];
|
||||
$e = '';
|
||||
}
|
||||
die("unknown element: $e\n") unless $ke;
|
||||
if (!ref($ke)) {
|
||||
push @$v, '0', '' if @$v == 1;
|
||||
die("element '$e' contains attributes @{[keys %{$v->[0]}]}\n") if %{$v->[0]};
|
||||
die("element '$e' has subelements\n") if $v->[1] ne '0';
|
||||
die("element '$e' must be singleton\n") if exists $out->{$e};
|
||||
Encode::_utf8_off($v->[2]) if $bytes;
|
||||
$out->{$e} = $v->[2];
|
||||
} elsif (@$ke == 1 && !ref($ke->[0])) {
|
||||
push @$v, '0', '' if @$v == 1;
|
||||
die("element '$e' contains attributes\n") if %{$v->[0]};
|
||||
die("element '$e' has subelements\n") if $v->[1] ne '0';
|
||||
Encode::_utf8_off($v->[2]) if $bytes;
|
||||
push @{$out->{$e}}, $v->[2];
|
||||
} else {
|
||||
if (@$ke == 1) {
|
||||
push @{$out->{$e}}, {};
|
||||
_workin($ke->[0], $out->{$e}->[-1], @$v);
|
||||
} else {
|
||||
die("element '$e' must be singleton\n") if exists $out->{$e};
|
||||
$out->{$e} = {};
|
||||
_workin($ke, $out->{$e}, @$v);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (exists $out->{'_content'}) {
|
||||
$out->{'_content'} =~ s/^ //s;
|
||||
$out->{'_content'} =~ s/ $//s;
|
||||
}
|
||||
}
|
||||
|
||||
sub _escape {
|
||||
my ($d) = @_;
|
||||
$d =~ s/&/&/sg;
|
||||
$d =~ s/</</sg;
|
||||
$d =~ s/>/>/sg;
|
||||
$d =~ s/"/"/sg;
|
||||
return $d;
|
||||
}
|
||||
|
||||
sub _workout {
|
||||
my ($how, $d, $indent) = @_;
|
||||
my @how = @$how;
|
||||
my $am = _escape(shift @how);
|
||||
my $ret = "$indent<$am";
|
||||
my $inelem;
|
||||
my %d2 = %$d;
|
||||
my $gotel = 0;
|
||||
if ($am eq '') {
|
||||
$ret = '';
|
||||
$gotel = $inelem = 1;
|
||||
$indent = substr($indent, 2);
|
||||
}
|
||||
for my $e (@how) {
|
||||
if (!$inelem && !ref($e) && $e ne '_content') {
|
||||
next unless exists $d2{$e};
|
||||
$ret .= _escape(" $e=").'"'._escape($d2{$e}).'"';
|
||||
delete $d2{$e};
|
||||
next;
|
||||
}
|
||||
$inelem = 1;
|
||||
next if ref($e) && !@$e; # magic inelem marker
|
||||
my $en = $e;
|
||||
$en = $en->[0] if ref($en);
|
||||
$en = $en->[0] if ref($en);
|
||||
next unless exists $d2{$en};
|
||||
my $ee = _escape($en);
|
||||
if (!ref($e) && $e eq '_content' && !$gotel) {
|
||||
$gotel = 2; # special marker to strip indent
|
||||
$ret .= ">"._escape($d2{$e})."\n";
|
||||
delete $d2{$e};
|
||||
next;
|
||||
}
|
||||
$ret .= ">\n" unless $gotel;
|
||||
$gotel = 1;
|
||||
if (!ref($e)) {
|
||||
die("'$e' must be scalar\n") if ref($d2{$e});
|
||||
if ($e eq '_content') {
|
||||
my $c = $d2{$e};
|
||||
$ret .= "$indent "._escape("$c\n");
|
||||
delete $d2{$e};
|
||||
next;
|
||||
}
|
||||
if (defined($d2{$e})) {
|
||||
$ret .= "$indent <$ee>"._escape($d2{$e})."</$ee>\n";
|
||||
} else {
|
||||
$ret .= "$indent <$ee/>\n";
|
||||
}
|
||||
delete $d2{$e};
|
||||
next;
|
||||
} elsif (@$e == 1 && !ref($e->[0])) {
|
||||
die("'$en' must be array\n") unless UNIVERSAL::isa($d2{$en}, 'ARRAY');
|
||||
for my $se (@{$d2{$en}}) {
|
||||
$ret .= "$indent <$ee>"._escape($se)."</$ee>\n";
|
||||
}
|
||||
delete $d2{$en};
|
||||
} elsif (@$e == 1) {
|
||||
die("'$en' must be array\n") unless UNIVERSAL::isa($d2{$en}, 'ARRAY');
|
||||
for my $se (@{$d2{$en}}) {
|
||||
die("'$en' must be array of hashes\n") unless UNIVERSAL::isa($se, 'HASH');
|
||||
$ret .= _workout($e->[0], $se, "$indent ");
|
||||
}
|
||||
delete $d2{$en};
|
||||
} else {
|
||||
die("'$en' must be hash\n") unless UNIVERSAL::isa($d2{$en}, 'HASH');
|
||||
$ret .= _workout($e, $d2{$en}, "$indent ");
|
||||
delete $d2{$en};
|
||||
}
|
||||
}
|
||||
die("excess hash entries: ".join(', ', sort keys %d2)."\n") if %d2;
|
||||
if ($gotel == 2 && $ret =~ s/\n$//s) {
|
||||
$ret .= "</$am>\n" unless $am eq '';
|
||||
} elsif ($gotel) {
|
||||
$ret .= "$indent</$am>\n" unless $am eq '';
|
||||
} else {
|
||||
$ret .= " />\n";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
||||
package XML::Structured::saxparser;
|
||||
|
||||
sub new {
|
||||
return bless [];
|
||||
}
|
||||
|
||||
sub start_document {
|
||||
my ($self) = @_;
|
||||
$self->[0] = [];
|
||||
}
|
||||
|
||||
sub start_element {
|
||||
my ($self, $e) = @_;
|
||||
my %as = map {$_->{'Name'} => $_->{'Value'}} values %{$e->{'Attributes'} || {}};
|
||||
push @{$self->[0]}, $e->{'Name'}, [ $self->[0], \%as ];
|
||||
$self->[0] = $self->[0]->[-1];
|
||||
}
|
||||
|
||||
sub end_element {
|
||||
my ($self) = @_;
|
||||
$self->[0] = shift @{$self->[0]};
|
||||
}
|
||||
|
||||
sub characters {
|
||||
my ($self, $c) = @_;
|
||||
|
||||
my $cl = $self->[0];
|
||||
if (@$cl > 2 && $cl->[-2] eq '0') {
|
||||
$cl->[-1] .= $c->{'Data'};
|
||||
} else {
|
||||
push @$cl, '0' => $c->{'Data'};
|
||||
}
|
||||
}
|
||||
|
||||
sub end_document {
|
||||
my ($self) = @_;
|
||||
return $self->[0];
|
||||
}
|
||||
|
||||
package XML::Structured;
|
||||
|
||||
my $xmlinparser;
|
||||
|
||||
sub _xmlparser {
|
||||
my ($str) = @_;
|
||||
my $p = new XML::Parser(Style => 'Tree');
|
||||
return $p->parse($str);
|
||||
}
|
||||
|
||||
sub _saxparser {
|
||||
my ($str) = @_;
|
||||
my $handler = new XML::Structured::saxparser;
|
||||
my $sp = XML::SAX::ParserFactory->parser('Handler' => $handler);
|
||||
if (ref(\$str) eq 'GLOB' || UNIVERSAL::isa($str, 'IO::Handle')) {
|
||||
return $sp->parse_file($str);
|
||||
}
|
||||
return $sp->parse_string($str);
|
||||
}
|
||||
|
||||
sub _chooseparser {
|
||||
eval { require XML::SAX; };
|
||||
my $saxok;
|
||||
if (!$@) {
|
||||
$saxok = 1;
|
||||
my $parsers = XML::SAX->parsers();
|
||||
return \&_saxparser if $parsers && @$parsers && (@$parsers > 1 || $parsers->[0]->{'Name'} ne 'XML::SAX::PurePerl');
|
||||
}
|
||||
eval { require XML::Parser; };
|
||||
return \&_xmlparser unless $@;
|
||||
return \&_saxparser if $saxok;
|
||||
die("XML::Structured needs either XML::SAX or XML::Parser\n");
|
||||
}
|
||||
|
||||
sub XMLin {
|
||||
my ($dtd, $str) = @_;
|
||||
$xmlinparser = _chooseparser() unless defined $xmlinparser;
|
||||
my $d = $xmlinparser->($str);
|
||||
my $out = {};
|
||||
$d = ['', [{}, @$d]] if $dtd->[0] eq '';
|
||||
die("document element must be '$dtd->[0]', was '$d->[0]'\n") if $d->[0] ne $dtd->[0];
|
||||
_workin($dtd, $out, @{$d->[1]});
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub XMLinfile {
|
||||
my ($dtd, $fn) = @_;
|
||||
local *F;
|
||||
open(F, '<', $fn) || die("$fn: $!\n");
|
||||
my $out = XMLin($dtd, *F);
|
||||
close F;
|
||||
return $out;
|
||||
}
|
||||
|
||||
sub XMLout {
|
||||
my ($dtd, $d) = @_;
|
||||
die("parameter is not a hash\n") unless UNIVERSAL::isa($d, 'HASH');
|
||||
if ($dtd->[0] eq '') {
|
||||
die("excess hash elements\n") if keys %$d > 1;
|
||||
for my $el (@$dtd) {
|
||||
return _workout($el, $d->{$el->[0]}, '') if ref($el) && $d->{$el->[0]};
|
||||
}
|
||||
die("no match for alternative\n");
|
||||
}
|
||||
return _workout($dtd, $d, '');
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
XML::Structured - simple conversion API from XML to perl structures and back
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use XML::Structured;
|
||||
|
||||
$dtd = [
|
||||
'element' =>
|
||||
'attribute1',
|
||||
'attribute2',
|
||||
[],
|
||||
'element1',
|
||||
[ 'element2' ],
|
||||
[ 'element3' =>
|
||||
...
|
||||
],
|
||||
[[ 'element4' =>
|
||||
...
|
||||
]],
|
||||
];
|
||||
|
||||
$hashref = XMLin($dtd, $xmlstring);
|
||||
$hashref = XMLinfile($dtd, $filename_or_glob);
|
||||
$xmlstring = XMLout($dtd, $hashref);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The XML::Structured module provides a way to convert xml data into
|
||||
a predefined perl data structure and back to xml. Unlike with modules
|
||||
like XML::Simple it is an error if the xml data does not match
|
||||
the provided skeleton (the "dtd"). Another advantage is that the
|
||||
order of the attributes and elements is taken from the dtd when
|
||||
converting back to xml.
|
||||
|
||||
=head2 XMLin()
|
||||
|
||||
The XMLin() function takes the dtd and a string as arguments and
|
||||
returns a hash reference containing the data.
|
||||
|
||||
=head2 XMLinfile()
|
||||
|
||||
This function works like C<XMLin()>, but takes a filename or a
|
||||
file descriptor glob as second argument.
|
||||
|
||||
=head2 XMLout()
|
||||
|
||||
C<XMLout()> provides the reverse operation to C<XMLin()>, it takes
|
||||
a dtd and a hash reference as arguments and returns an XML string.
|
||||
|
||||
=head1 The DTD
|
||||
|
||||
The dtd parameter specifies the structure of the allowed xml data.
|
||||
It consists of nested perl arrays.
|
||||
|
||||
=head2 simple attributes and elements
|
||||
|
||||
The very simple example for a dtd is:
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
'password',
|
||||
];
|
||||
|
||||
This dtd will accept/create XML like:
|
||||
|
||||
<user login="foo" password="bar" />
|
||||
|
||||
XMLin doesn't care if "login" or "password" are attributes or
|
||||
elements, so
|
||||
|
||||
<user>
|
||||
<login>foo</login>
|
||||
<password>bar</password>
|
||||
</user>
|
||||
|
||||
is also valid input (but doesn't get re-created by C<XMLout()>).
|
||||
|
||||
=head2 multiple elements of the same name
|
||||
|
||||
If an element may appear multiple times, it must be declared as
|
||||
an array in the dtd:
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
[ 'favorite_fruits' ],
|
||||
];
|
||||
|
||||
XMLin will create an array reference as value in this case, even if
|
||||
the xml data contains only one element. Valid XML looks like:
|
||||
|
||||
<user login="foo">
|
||||
<favorite_fruits>apple</favorite_fruits>
|
||||
<favorite_fruits>peach</favorite_fruits>
|
||||
</user>
|
||||
|
||||
As attributes may not appear multiple times, XMLout will create
|
||||
elements for this case. Note also that all attributes must come
|
||||
before the first element, thus the first array in the dtd ends
|
||||
the attribute list. As an example, the following dtd
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
[ 'favorite_fruits' ],
|
||||
'password',
|
||||
];
|
||||
|
||||
will create xml like:
|
||||
|
||||
<user login="foo">
|
||||
<favorite_fruits>apple</favorite_fruits>
|
||||
<favorite_fruits>peach</favorite_fruits>
|
||||
<password>bar</password>
|
||||
</user>
|
||||
|
||||
"login" is translated to an attribute and "password" to an element.
|
||||
|
||||
You can use an empty array reference to force the end of the attribute
|
||||
list, e.g.:
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
[],
|
||||
'login',
|
||||
'password',
|
||||
];
|
||||
|
||||
will translate to
|
||||
|
||||
<user>
|
||||
<login>foo</login>
|
||||
<password>bar</password>
|
||||
</user>
|
||||
|
||||
instead of
|
||||
|
||||
<user login="foo" password="bar" />
|
||||
|
||||
=head2 sub-elements
|
||||
|
||||
sub-elements are elements that also contain attributes or other
|
||||
elements. They are specified in the dtd as arrays with more than
|
||||
one element. Here is an example:
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
[ 'address' =>
|
||||
'street',
|
||||
'city',
|
||||
],
|
||||
];
|
||||
|
||||
Valid xml for this dtd looks like:
|
||||
|
||||
<user login="foo">
|
||||
<address street="broadway 7" city="new york" />
|
||||
</user>
|
||||
|
||||
It is sometimes useful to specify such dtds in multiple steps:
|
||||
|
||||
$addressdtd = [ 'address' =>
|
||||
'street',
|
||||
'city',
|
||||
];
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
$addressdtd,
|
||||
];
|
||||
|
||||
=head2 multiple sub-elements with the same name
|
||||
|
||||
As with simple elements, one can allow sub-elements to occur multiple
|
||||
times. C<XMLin()> creates an array of hash references in this case.
|
||||
The dtd specification uses an array reference to an array for this
|
||||
case, for example:
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
[[ 'address' =>
|
||||
'street',
|
||||
'city',
|
||||
]],
|
||||
];
|
||||
Or, with the $addressdtd definition used in the previous example:
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
[ $addressdtd ],
|
||||
];
|
||||
|
||||
Accepted XML is:
|
||||
|
||||
<user login="foo">
|
||||
<address street="broadway 7" city="new york" />
|
||||
<address street="rural road 12" city="tempe" />
|
||||
</user>
|
||||
|
||||
=head2 the _content pseudo-element
|
||||
|
||||
All of the non-whitespace parts between elements get collected
|
||||
into a single "_content" element. As example,
|
||||
|
||||
<user login="foo">
|
||||
<address street="broadway 7" city="new york"/>hello
|
||||
<address street="rural road 12" city="tempe"/>world
|
||||
</user>
|
||||
|
||||
would set the _content element to C<hello world> (the dtd must allow
|
||||
a _content element, of course). If the dtd is
|
||||
|
||||
$dtd = [ 'user' =>
|
||||
'login',
|
||||
[ $addressdtd ],
|
||||
'_content',
|
||||
];
|
||||
|
||||
the xml string created by XMLout() will be:
|
||||
|
||||
<user login="foo">
|
||||
<address street="broadway 7" city="new york" />
|
||||
<address street="rural road 12" city="tempe" />
|
||||
hello world
|
||||
</user>
|
||||
|
||||
The exact input cannot be re-created, as the positions and the
|
||||
fragmentation of the content data is lost.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
B<XML::Structured> requires either L<XML::Parser> or L<XML::SAX>.
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2006 Michael Schroeder E<lt>mls@suse.deE<gt>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
@ -1,99 +0,0 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
BEGIN {
|
||||
my ($wd) = $0 =~ m-(.*)/- ;
|
||||
$wd ||= '.';
|
||||
unshift @INC, "$wd/bs_copy";
|
||||
}
|
||||
|
||||
use lib 'bs_copy';
|
||||
use BSUtil;
|
||||
use BSRPC ':https';
|
||||
use BSXML;
|
||||
use BSHTTP;
|
||||
use Fcntl qw/:flock/;
|
||||
use File::Path qw/make_path/;
|
||||
|
||||
use strict;
|
||||
|
||||
my $nodebug;
|
||||
|
||||
while (@ARGV) {
|
||||
if ($ARGV[0] eq '--nodebug') {
|
||||
$nodebug = 1;
|
||||
} elsif ($ARGV[0] eq '--') {
|
||||
shift @ARGV;
|
||||
last;
|
||||
} elsif ($ARGV[0] =~ /^-/) {
|
||||
die("unknown option $ARGV[0]\n");
|
||||
} else {
|
||||
last;
|
||||
}
|
||||
shift @ARGV;
|
||||
}
|
||||
|
||||
if (@ARGV != 2) {
|
||||
my $message = "Usage: $0 url dir
|
||||
|
||||
Example: $0 https://api.opensuse.org/public/build/YaST:Head/openSUSE_Tumbleweed/x86_64 my-mirror\n";
|
||||
die($message);
|
||||
}
|
||||
my ($url, $dir) = @ARGV;
|
||||
$url =~ s/\/$//;
|
||||
|
||||
unless (-d $dir) {
|
||||
make_path($dir);
|
||||
}
|
||||
|
||||
open(my $fh, '>', $dir.'/.lock') or die "failed to open lock file: $!\n";
|
||||
unless(flock($fh, LOCK_EX|LOCK_NB)) {
|
||||
print "$dir is locked, waiting ...\n";
|
||||
flock($fh, LOCK_EX) or die "failed to lock: $!\n";
|
||||
print "... lock released\n";
|
||||
}
|
||||
|
||||
#print "receiving tree state\n";
|
||||
my $bvl = BSRPC::rpc("$url/_repository", $BSXML::binaryversionlist, "view=binaryversions", "nometa=1");
|
||||
my @localbins = grep {/^[0-9a-f]{32}-.+\.rpm$/} ls($dir);
|
||||
my %localbins = map {$_ => 1} @localbins;
|
||||
my %remotebins;
|
||||
for my $bv (@{$bvl->{'binary'} || []}) {
|
||||
next unless $bv->{'name'} =~ /\.rpm$/;
|
||||
next if $nodebug && $bv->{'name'} =~ /-debug(?:info|source|info-32bit)\.rpm$/;
|
||||
$remotebins{"$bv->{'hdrmd5'}-$bv->{'name'}"} = $bv;
|
||||
}
|
||||
my @todelete = grep {!$remotebins{$_}} sort keys %localbins;
|
||||
my @todownload = grep {!$localbins{$_}} sort keys %remotebins;
|
||||
if (@todelete) {
|
||||
print "deleting ".@todelete." old packages\n";
|
||||
for my $bin (@todelete) {
|
||||
unlink("$dir/$bin") || die("unlink: $!\n");
|
||||
}
|
||||
}
|
||||
if (@todownload) {
|
||||
print "downloading ".@todownload." new packages\n";
|
||||
my $todo = @todownload;
|
||||
my $did = 0;
|
||||
while (@todownload) {
|
||||
my @fetch = splice(@todownload, 0, 50);
|
||||
my @args;
|
||||
for (@fetch) {
|
||||
die unless /^[0-9a-f]{32}-(.+)\.rpm$/;
|
||||
push @args, "binary=$1";
|
||||
}
|
||||
my $param = {
|
||||
'uri' => "$url/_repository",
|
||||
'directory' => $dir,
|
||||
'map' => sub {
|
||||
my ($param, $name) = @_;
|
||||
return undef unless $name =~ /^(.+)-([0-9a-f]{32})$/;
|
||||
return "$2-$1.rpm";
|
||||
},
|
||||
'receiver' => \&BSHTTP::cpio_receiver,
|
||||
};
|
||||
BSRPC::rpc($param, undef, 'view=cpioheaders', @args);
|
||||
$did += @fetch;
|
||||
#print "$did/$todo\n";
|
||||
}
|
||||
}
|
||||
#print "done, we now have ".(keys %remotebins)." packages.\n";
|
||||
5
dist/package/openSUSE-release-tools.spec
vendored
5
dist/package/openSUSE-release-tools.spec
vendored
@ -63,10 +63,6 @@ Requires: python3-requests
|
||||
Requires: python3-typing_extensions
|
||||
%endif
|
||||
|
||||
# bs_mirrorfull
|
||||
Requires: perl-Net-SSLeay
|
||||
Requires: perl-XML-Parser
|
||||
|
||||
# Spec related requirements.
|
||||
Requires: osclib = %{version}
|
||||
|
||||
@ -363,7 +359,6 @@ exit 0
|
||||
%files
|
||||
%doc README.md
|
||||
%{_bindir}/osrt-biarchtool
|
||||
%{_bindir}/osrt-bs_mirrorfull
|
||||
%{_bindir}/osrt-bugowner
|
||||
%{_bindir}/osrt-build-fail-reminder
|
||||
%{_bindir}/osrt-checknewer
|
||||
|
||||
@ -8,10 +8,12 @@ import glob
|
||||
from fnmatch import fnmatch
|
||||
from lxml import etree as ET
|
||||
from osc.core import http_GET
|
||||
from osc.core import makeurl
|
||||
|
||||
import yaml
|
||||
|
||||
from osclib.cache_manager import CacheManager
|
||||
from osclib.repomirror import RepoMirror
|
||||
|
||||
logger = logging.getLogger('InstallChecker')
|
||||
|
||||
@ -192,13 +194,16 @@ def mirrorRepomd(cachedir, url):
|
||||
|
||||
|
||||
def mirror(apiurl, project, repository, arch):
|
||||
"""Call bs_mirrorfull script to mirror packages."""
|
||||
"""
|
||||
Mirror repo metadata for the given pra.
|
||||
Downloads primary.xml for DoD or all RPM headers in the full tree.
|
||||
"""
|
||||
directory = os.path.join(CACHEDIR, project, repository, arch)
|
||||
|
||||
if not os.path.exists(directory):
|
||||
os.makedirs(directory)
|
||||
|
||||
meta = ET.parse(http_GET('{}/public/source/{}/_meta'.format(apiurl, project))).getroot()
|
||||
meta = ET.parse(http_GET(makeurl(apiurl, ['source', project, '_meta']))).getroot()
|
||||
repotag = meta.xpath("/project/repository[@name='{}']".format(repository))[0]
|
||||
if arch not in repotag.xpath("./arch/text()"):
|
||||
# Arch not in this project, skip mirroring
|
||||
@ -213,13 +218,7 @@ def mirror(apiurl, project, repository, arch):
|
||||
raise Exception('repotype {} not supported'.format(repotype))
|
||||
return mirrorRepomd(directory, download[0].get('url'))
|
||||
|
||||
script = os.path.join(SCRIPT_PATH, '..', 'bs_mirrorfull')
|
||||
path = '/'.join((project, repository, arch))
|
||||
logger.info('mirroring {}'.format(path))
|
||||
url = '{}/public/build/{}'.format(apiurl, path)
|
||||
p = subprocess.run(['perl', script, '--nodebug', url, directory])
|
||||
|
||||
if p.returncode:
|
||||
raise Exception('failed to mirror {}'.format(path))
|
||||
rm = RepoMirror(apiurl)
|
||||
rm.mirror(directory, project, repository, arch)
|
||||
|
||||
return directory
|
||||
|
||||
138
osclib/repomirror.py
Normal file
138
osclib/repomirror.py
Normal file
@ -0,0 +1,138 @@
|
||||
import fcntl
|
||||
import itertools
|
||||
import logging
|
||||
import os
|
||||
import osc.conf
|
||||
import re
|
||||
import struct
|
||||
import sys
|
||||
import tempfile
|
||||
|
||||
from lxml import etree as ET
|
||||
from osc.core import http_GET
|
||||
from osc.core import makeurl
|
||||
from osc.util.cpio import CpioHdr
|
||||
from urllib.parse import quote_plus
|
||||
|
||||
logger = logging.getLogger('RepoMirror')
|
||||
|
||||
|
||||
class RepoMirror:
|
||||
def __init__(self, apiurl, nameignore: str = '-debug(info|source|info-32bit).rpm$'):
|
||||
"""
|
||||
Class to mirror RPM headers of all binaries in a repo on OBS (full tree).
|
||||
Debug packages are ignored by default, see the nameignore parameter.
|
||||
"""
|
||||
self.apiurl = apiurl
|
||||
self.nameignorere = re.compile(nameignore)
|
||||
|
||||
def extract_cpio_stream(self, destdir: str, stream):
|
||||
hdr_fmt = '6s8s8s8s8s8s8s8s8s8s8s8s8s8s'
|
||||
hdr_len = 110
|
||||
|
||||
name_re = re.compile('^([^/]+)-([0-9a-f]{32})$')
|
||||
|
||||
while True:
|
||||
# Read and parse the CPIO header
|
||||
hdrdata = stream.read(hdr_len)
|
||||
hdrtuples = struct.unpack(hdr_fmt, hdrdata)
|
||||
if hdrtuples[0] != b'070701':
|
||||
raise NotImplementedError(f'CPIO format {hdrtuples[0]} not implemented')
|
||||
|
||||
# The new-ascii format has padding for 4 byte alignment
|
||||
def align():
|
||||
stream.read((4 - (stream.tell() % 4)) % 4)
|
||||
|
||||
hdr = CpioHdr(*hdrtuples)
|
||||
hdr.filename = stream.read(hdr.namesize - 1).decode('ascii')
|
||||
stream.read(1) # Skip terminator
|
||||
align()
|
||||
|
||||
binarymatch = name_re.match(hdr.filename)
|
||||
if hdr.filename == '.errors':
|
||||
content = stream.read(hdr.filesize)
|
||||
raise RuntimeError('Download has errors: ' + content.decode('ascii'))
|
||||
elif binarymatch:
|
||||
name = binarymatch.group(1)
|
||||
md5 = binarymatch.group(2)
|
||||
destpath = os.path.join(destdir, f'{md5}-{name}.rpm')
|
||||
with tempfile.NamedTemporaryFile(mode='wb', dir=destdir) as tmpfile:
|
||||
# Probably not big enough to need chunking
|
||||
tmpfile.write(stream.read(hdr.filesize))
|
||||
os.link(tmpfile.name, destpath)
|
||||
# Would be nice to use O_TMPFILE + link here, but python passes
|
||||
# O_EXCL which breaks that.
|
||||
# os.link(f'/proc/self/fd/{tmpfile.fileno()}', destpath)
|
||||
|
||||
align()
|
||||
elif hdr.filename == 'TRAILER!!!':
|
||||
if stream.read(1):
|
||||
raise RuntimeError('Expected end of CPIO')
|
||||
break
|
||||
else:
|
||||
raise NotImplementedError(f'Unhandled file {hdr.filename} in archive')
|
||||
|
||||
def _mirror(self, destdir: str, prj: str, repo: str, arch: str) -> None:
|
||||
"Using the _repositories endpoint, download all RPM headers into destdir."
|
||||
logger.info(f'Mirroring {prj}/{repo}/{arch}')
|
||||
pkglistxml = http_GET(makeurl(self.apiurl, ['build', prj, repo, arch, '_repository'],
|
||||
query={'view': 'binaryversions', 'nometa': 1}))
|
||||
root = ET.parse(pkglistxml).getroot()
|
||||
remotebins: dict[str, str] = {}
|
||||
for binary in root.findall('binary'):
|
||||
name = binary.get('name')
|
||||
if name.endswith('.rpm') and not self.nameignorere.search(name):
|
||||
hdrmd5 = binary.get('hdrmd5')
|
||||
remotebins[f'{hdrmd5}-{name}'] = name[:-4]
|
||||
|
||||
to_delete: list[str] = []
|
||||
for filename in os.listdir(destdir):
|
||||
if not filename.endswith('.rpm'):
|
||||
continue
|
||||
|
||||
if filename in remotebins:
|
||||
del remotebins[filename] # Already downloaded
|
||||
else:
|
||||
to_delete.append(os.path.join(destdir, filename))
|
||||
|
||||
if to_delete:
|
||||
logger.info(f'Deleting {len(to_delete)} old packages')
|
||||
for path in to_delete:
|
||||
os.unlink(path)
|
||||
|
||||
if remotebins:
|
||||
logger.info(f'Downloading {len(remotebins)} new packages')
|
||||
binaries = remotebins.values()
|
||||
|
||||
# Download in batches of 50
|
||||
for chunk in range(0, len(binaries), 50):
|
||||
query = 'view=cpioheaders'
|
||||
for binary in itertools.islice(binaries, chunk, chunk + 50):
|
||||
query += '&binary=' + quote_plus(binary)
|
||||
|
||||
req = http_GET(makeurl(self.apiurl, ['build', prj, repo, arch, '_repository'],
|
||||
query=query))
|
||||
self.extract_cpio_stream(destdir, req)
|
||||
|
||||
def mirror(self, destdir: str, prj: str, repo: str, arch: str) -> None:
|
||||
"Creates destdir and locks destdir/.lock before mirroring."
|
||||
os.makedirs(destdir, exist_ok=True)
|
||||
|
||||
with open(os.path.join(destdir, '.lock'), 'w') as lockfile:
|
||||
try:
|
||||
fcntl.flock(lockfile, fcntl.LOCK_EX | fcntl.LOCK_NB)
|
||||
except IOError:
|
||||
logger.info(destdir + 'is locked, waiting... ', end='')
|
||||
fcntl.flock(lockfile, fcntl.LOCK_EX)
|
||||
logger.info('acquired!')
|
||||
|
||||
return self._mirror(destdir, prj, repo, arch)
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
if len(sys.argv) != 6:
|
||||
print("Usage: repomirror.py apiurl destdir prj repo arch")
|
||||
else:
|
||||
osc.conf.get_config()
|
||||
rm = RepoMirror(sys.argv[1])
|
||||
rm.mirror(sys.argv[2], sys.argv[3], sys.argv[4], sys.argv[5])
|
||||
@ -25,6 +25,7 @@ from osclib.core import repository_path_expand
|
||||
from osclib.core import repository_arch_state
|
||||
from osclib.cache_manager import CacheManager
|
||||
from osclib.pkglistgen_comments import PkglistComments
|
||||
from osclib.repomirror import RepoMirror
|
||||
|
||||
from urllib.parse import urlparse
|
||||
|
||||
@ -354,18 +355,8 @@ class PkgListGen(ToolBase.ToolBase):
|
||||
|
||||
self.logger.debug('updating %s', d)
|
||||
|
||||
# only there to parse the repos
|
||||
bs_mirrorfull = os.path.join(SCRIPT_PATH, '..', 'bs_mirrorfull')
|
||||
|
||||
args = [bs_mirrorfull]
|
||||
args.append('--nodebug')
|
||||
args.append('{}/public/build/{}/{}/{}'.format(self.apiurl, project, repo, arch))
|
||||
args.append(d)
|
||||
with subprocess.Popen(args, stdout=subprocess.PIPE) as p:
|
||||
for line in p.stdout:
|
||||
self.logger.info(line.decode('utf-8').rstrip())
|
||||
if p.wait() != 0:
|
||||
raise Exception("Mirroring repository failed")
|
||||
rm = RepoMirror(self.apiurl)
|
||||
rm.mirror(d, project, repo, arch)
|
||||
|
||||
files = [os.path.join(d, f)
|
||||
for f in os.listdir(d) if f.endswith('.rpm')]
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user