… | |
… | |
9 | $cf::CFG{metaserver2_urls} |
9 | $cf::CFG{metaserver2_urls} |
10 | or return; |
10 | or return; |
11 | |
11 | |
12 | our $UPDATE_METASERVER2 = Event->timer ( |
12 | our $UPDATE_METASERVER2 = Event->timer ( |
13 | reentrant => 0, |
13 | reentrant => 0, |
14 | after => 0, |
14 | after => 37, |
15 | interval => 299, # crossfire itself uses 60something as interval |
15 | interval => 299, # crossfire itself uses 60something as interval |
16 | hard => 1, |
16 | hard => 1, |
17 | data => cf::WF_AUTOCANCEL, |
17 | data => cf::WF_AUTOCANCEL, |
18 | cb => Coro::unblock_sub { |
18 | cb => Coro::unblock_sub { |
19 | my %form = ( |
19 | my %form = ( |
… | |
… | |
40 | my $content = |
40 | my $content = |
41 | join "&", |
41 | join "&", |
42 | map "$_=" . (URI::Escape::uri_escape_utf8 $form{$_}), |
42 | map "$_=" . (URI::Escape::uri_escape_utf8 $form{$_}), |
43 | keys %form; |
43 | keys %form; |
44 | |
44 | |
45 | $content .= "\015\012"; # for good form |
|
|
46 | |
|
|
47 | # this is a bit hacky, but hey, invoking LWP on something so trivial feels like a sin |
45 | # this is a bit hacky, but hey, invoking LWP on something so trivial feels like a sin |
48 | |
46 | |
49 | for my $url (@{ $cf::CFG{metaserver2_urls} || [] }) { |
47 | for my $url (@{ $cf::CFG{metaserver2_urls} || [] }) { |
50 | $url = new URI $url |
48 | $url = new URI $url |
51 | or next; |
49 | or next; |
… | |
… | |
60 | |
58 | |
61 | syswrite $socket, join "", |
59 | syswrite $socket, join "", |
62 | "POST ", $url->path, " HTTP/1.0\015\012", |
60 | "POST ", $url->path, " HTTP/1.0\015\012", |
63 | "Host: ", $url->host, "\015\012", |
61 | "Host: ", $url->host, "\015\012", |
64 | "Content-Type: application/x-www-form-urlencoded\015\012", |
62 | "Content-Type: application/x-www-form-urlencoded\015\012", |
65 | "User-Agent: Crossfire TRT Server (http://crossfire.schmorp.de)\015\012", |
63 | "User-Agent: Deliantra Server (+http://www.deliantra.net/)\015\012", |
66 | "Content-Length: ", length $content, "\015\012", |
64 | "Content-Length: ", length $content, "\015\012", |
67 | "\015\012", |
65 | "\015\012", |
68 | $content |
66 | $content |
69 | ; |
67 | ; |
70 | |
68 | |
… | |
… | |
73 | my $response = $socket->readline (undef); |
71 | my $response = $socket->readline (undef); |
74 | |
72 | |
75 | unless ($response =~ /^HTTP\/[0-9.]+\s+200\s+/) { |
73 | unless ($response =~ /^HTTP\/[0-9.]+\s+200\s+/) { |
76 | warn "$url: $response\n"; |
74 | warn "$url: $response\n"; |
77 | } |
75 | } |
78 | warn $response; |
|
|
79 | } |
76 | } |
80 | |
|
|
81 | # syswrite $socket, $pkt; |
|
|
82 | }, |
77 | }, |
83 | ); |
78 | ); |
84 | |
79 | |