chiark
/
gitweb
/
~yarrgweb
/
ypp-sc-tools.main.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Take out lock in db-idempotent-populate too
[ypp-sc-tools.main.git]
/
yarrg
/
Commods.pm
diff --git
a/yarrg/Commods.pm
b/yarrg/Commods.pm
index 9b190c4b3a88d5236cc1e9ff9f41058a12118be2..5003037b1389b4cede801a2300dea6e99be69c42 100644
(file)
--- a/
yarrg/Commods.pm
+++ b/
yarrg/Commods.pm
@@
-23,6
+23,7
@@
package Commods;
use IO::File;
use HTTP::Request::Common ();
package Commods;
use IO::File;
use HTTP::Request::Common ();
+use POSIX;
use strict;
use warnings;
use strict;
use warnings;
@@
-32,7
+33,7
@@
BEGIN {
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = 1.00;
@ISA = qw(Exporter);
- @EXPORT = qw(&parse_info
1 &rsync_master
+ @EXPORT = qw(&parse_info
_clientside &fetch_with_rsync
&parse_info_serverside &parse_info_serverside_ocean
%oceans %commods %clients %routes %route_mysteries
&parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
&parse_info_serverside &parse_info_serverside_ocean
%oceans %commods %clients %routes %route_mysteries
&parse_pctb_commodmap %pctb_commodmap @pctb_commodmap
@@
-40,7
+41,7
@@
BEGIN {
&pipethrough_prep &pipethrough_run
&pipethrough_run_along &pipethrough_run_finish
&pipethrough_run_gzip
&pipethrough_prep &pipethrough_run
&pipethrough_run_along &pipethrough_run_finish
&pipethrough_run_gzip
- &cgipostform);
+ &cgipostform
&yarrgpostform &cgi_get_caller
);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw();
%EXPORT_TAGS = ( );
@EXPORT_OK = qw();
@@
-144,7
+145,12
@@
sub parse_info_clientside () {
return unless $yarrg;
my $master= fetch_with_rsync('info');
parse_info1($master,'s');
return unless $yarrg;
my $master= fetch_with_rsync('info');
parse_info1($master,'s');
- parse_info1('_local-info.txt','s');
+ my $local= '_local-info.txt';
+ if (stat $local) {
+ parse_info1($local,'s');
+ } else {
+ die "$local $!" unless $! == &ENOENT;
+ }
}
sub fetch_with_rsync ($) {
}
sub fetch_with_rsync ($) {
@@
-160,6
+166,7
@@
sub fetch_with_rsync ($) {
$!=0; system 'rsync','-Lt','--',$remote,$local;
die "$? $!" if $! or $?;
}
$!=0; system 'rsync','-Lt','--',$remote,$local;
die "$? $!" if $! or $?;
}
+ return $local;
}
sub parse_info_maproutes ($$$) {
}
sub parse_info_maproutes ($$$) {
@@
-252,6
+259,14
@@
sub pipethrough_run_gzip ($) {
pipethrough_run($_[0],undef,'gzip','gzip');
}
pipethrough_run($_[0],undef,'gzip','gzip');
}
+sub yarrgpostform ($$) {
+ my ($ua, $form) = @_;
+ my $dest= $ENV{'YPPSC_YARRG_YARRG'};
+ get_our_version($form, 'client');
+ die unless $dest =~ m,/$,;
+ return cgipostform($ua, "${dest}commod-update-receiver", $form);
+}
+
sub cgipostform ($$$) {
my ($ua, $url, $form) = @_;
my $req= HTTP::Request::Common::POST($url,
sub cgipostform ($$$) {
my ($ua, $url, $form) = @_;
my $req= HTTP::Request::Common::POST($url,
@@
-283,7
+298,7
@@
sub cgipostform ($$$) {
$out =~ m,^Content-Type: text/plain.*\n\n, or die "$out ?";
return $';
} else {
$out =~ m,^Content-Type: text/plain.*\n\n, or die "$out ?";
return $';
} else {
- my $resp= $ua->request($
url,$
req);
+ my $resp= $ua->request($req);
die $resp->status_line unless $resp->is_success;
return $resp->content();
}
die $resp->status_line unless $resp->is_success;
return $resp->content();
}
@@
-325,4
+340,17
@@
sub check_tsv_line ($$) {
return @v;
}
return @v;
}
+sub cgi_get_caller () {
+ my $caller= $ENV{'REMOTE_ADDR'};
+ $caller= 'LOCAL' unless defined $caller;
+
+ my $fwdf= $ENV{'HTTP_X_FORWARDED_FOR'};
+ if (defined $fwdf) {
+ $fwdf =~ s/\s//g;
+ $fwdf =~ s/[^0-9.,]/?/g;
+ $caller= "$fwdf";
+ }
+ return $caller;
+}
+
1;
1;