source: subversion/applications/utils/revert/OsmApi.pm @ 28542

Last change on this file since 28542 was 28542, checked in by frederik, 7 years ago

add retry, get_with_credentials

  • Property svn:keywords set to Revision
File size: 3.7 KB
Line 
1#!/usr/bin/perl
2
3# OsmApi.pm
4# ---------
5#
6# Implements OSM API connectivity
7#
8# Part of the "osmtools" suite of programs
9# Originally written by Frederik Ramm <frederik@remote.org>; public domain
10
11package OsmApi;
12
13use strict;
14use warnings;
15use LWP::UserAgent;
16use MIME::Base64;
17
18our $prefs;
19our $ua;
20our $dummy;
21
22BEGIN
23{
24
25    $prefs = { "dryrun" => 1 };
26
27    open (PREFS, $ENV{HOME}."/.osmtoolsrc") or die "cannot open ". $ENV{HOME}."/.osmtoolsrc";
28    while(<PREFS>)
29    {
30        if (/^(\S+)\s*=\s*(.*)/)
31        {
32            $prefs->{$1} = $2;
33        }
34    }
35    close (PREFS);
36
37    foreach my $required("username","password","apiurl")
38    {
39        die $ENV{HOME}."/.osmtoolsrc does not have $required" unless defined($prefs->{$required});
40    }
41
42    if (!defined($prefs->{instance}))
43    {
44        $prefs->{instance} = sprintf "%010x", $$ * rand(100000000);
45        open(PREFS, ">>".$ENV{HOME}."/.osmtoolsrc");
46        printf PREFS "instance=".$prefs->{instance};
47        close(PREFS);
48    }
49
50    $prefs->{apiurl} =~ m!https?://([^/]+)/!;
51    my $host = $1;
52    $host .= ":80" unless ($host =~ /:/);
53    $ua = LWP::UserAgent->new;
54    $ua->credentials($host, "Web Password", $prefs->{username}, $prefs->{password});
55    my $revision = '$Revision: 28542 $';
56    my $revno = 0;
57    $revno = $1 if ($revision =~ /:\s*(\d+)/);
58    $ua->agent("osmtools/$revno ($^O, ".$prefs->{instance}.")");
59    $ua->timeout(600);
60
61    $prefs->{debug} = $prefs->{dryrun} unless (defined($prefs->{debug}));
62
63    $dummy = HTTP::Response->new(200);
64}
65
66sub repeat
67{
68    my $req = shift;
69    my $resp;
70    for (my $i=0; $i<3; $i++)
71    {
72        $resp = $ua->request($req);
73        return $resp unless ($resp->code == 502);
74        sleep 1;
75    }
76    return $resp;
77}
78
79sub get
80{
81    my $url = shift;
82    my $req = HTTP::Request->new(GET => $prefs->{apiurl}.$url);
83    my $resp = repeat($req);
84    debuglog($req, $resp) if ($prefs->{"debug"});
85    return($resp);
86}
87
88sub get_with_credentials
89{
90    my $url = shift;
91    my $req = HTTP::Request->new(GET => $prefs->{apiurl}.$url);
92    $req->header("Authorization" => "Basic ".encode_base64($prefs->{username}.":".$prefs->{password}));
93    my $resp = repeat($req);
94    debuglog($req, $resp) if ($prefs->{"debug"});
95    return($resp);
96}
97
98sub put
99{
100    my $url = shift;
101    my $body = shift;
102    return dummylog("PUT", $url, $body) if ($prefs->{dryrun});
103    my $req = HTTP::Request->new(PUT => $prefs->{apiurl}.$url);
104    $req->header("Content-type" => "text/xml");
105    $req->content($body) if defined($body);
106    my $resp = repeat($req);
107    debuglog($req, $resp) if ($prefs->{"debug"});
108    return $resp;
109}
110
111sub post
112{
113    my $url = shift;
114    my $body = shift;
115    return dummylog("POST", $url, $body) if ($prefs->{dryrun});
116    my $req = HTTP::Request->new(POST => $prefs->{apiurl}.$url);
117    $req->content($body) if defined($body);
118    $req->header("Content-type" => "text/xml");
119    my $resp = repeat($req);
120    debuglog($req, $resp) if ($prefs->{"debug"});
121    return $resp;
122}
123
124sub delete
125{
126    my $url = shift;
127    my $body = shift;
128    return dummylog("DELETE", $url, $body) if ($prefs->{dryrun});
129    my $req = HTTP::Request->new(DELETE => $prefs->{apiurl}.$url);
130    $req->header("Content-type" => "text/xml");
131    $req->content($body) if defined($body);
132    my $resp = repeat($req);
133    debuglog($req, $resp) if ($prefs->{"debug"});
134    return $resp;
135}
136
137sub debuglog
138{
139    my ($request, $response) = @_;
140    printf STDERR "%s %s... %s %s (%db)\n",
141        $request->method(), 
142        $request->uri(), 
143        $response->code(), 
144        $response->message(), 
145        length($response->content());
146}
147
148sub dummylog
149{
150    my ($method, $url, $body) = @_;
151    print STDERR "$method $url\n";
152    print STDERR "$body\n\n";
153    return $dummy;
154}
155sub set_timeout
156{
157    my $to = shift;
158    $ua->timeout($to);
159}
160
1611;
Note: See TracBrowser for help on using the repository browser.