source: subversion/applications/rendering/tilesAtHome/upload.pl @ 9946

Revision 9946, 11.6 KB checked in by spaetz, 6 years ago (diff)

rework UploadOkOrNot? to not store a 5 digit number as temporary file on disk. Also notify user in case of HTTP error and return full queue then.

  • Property svn:executable set to *
Line 
1#!/usr/bin/perl
2use strict;
3use FindBin qw($Bin);
4use LWP::UserAgent;
5use File::Copy;
6use Fcntl ':flock'; #import LOCK_* constants
7use English '-no_match_vars';
8use tahconfig;
9use tahlib;
10use AppConfig qw(:argcount);
11
12#-----------------------------------------------------------------------------
13# OpenStreetMap tiles@home, upload module
14# Takes any tiles generated, adds them into ZIP files, and uploads them
15#
16# Contact OJW on the Openstreetmap wiki for help using this program
17#-----------------------------------------------------------------------------
18# Copyright 2006, Oliver White, Dirk-Lueder Kreie
19#
20# This program is free software; you can redistribute it and/or
21# modify it under the terms of the GNU General Public License
22# as published by the Free Software Foundation; either version 2
23# of the License, or (at your option) any later version.
24#
25# This program is distributed in the hope that it will be useful,
26# but WITHOUT ANY WARRANTY; without even the implied warranty of
27# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
28# GNU General Public License for more details.
29#
30# You should have received a copy of the GNU General Public License
31# along with this program; if not, write to the Free Software
32# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
33#-----------------------------------------------------------------------------
34if ($#ARGV < 0) 
35{  # no command line option supplied, we require ($Mode, $progressJobs)
36   die "please call \"tilesGen.pl upload\" instead";
37}
38
39
40# conf file, will contain username/password and environment info
41# Read the config file
42our $Config = AppConfig->new({
43                CREATE => 1,                      # Autocreate unknown config variables
44                GLOBAL => {
45                  DEFAULT  => undef,    # Create undefined Variables by default
46                  ARGCOUNT => ARGCOUNT_ONE, # Simple Values (no arrays, no hashmaps)
47                }
48              });
49
50$Config->define("help|usage!");
51$Config->define("nodownload=s");
52$Config->set("nodownload",0);
53$Config->file("config.defaults", "layers.conf", "tilesAtHome.conf", "authentication.conf"); #first read configs in order, each (possibly) overwriting settings from the previous
54$Config->args();              # overwrite config options with command line options
55$Config->file("general.conf");  # overwrite with hardcoded values that must not be changed
56
57if ($Config->get("LocalSlippymap"))
58{
59    print "No upload - LocalSlippymap set in config file\n";
60    exit 1;
61}
62
63
64my $ZipFileCount = 0;
65
66## FIXME: this is one of the things that make upload.pl not multithread safe
67my $ZipDir = $Config->get("WorkingDirectory") . "/uploadable";
68
69my @sorted;
70
71# when called from tilesGen, use these for nice display
72my $progress = 0;
73our $progressPercent = 0;
74our $progressJobs;
75our $currentSubTask = "upload";
76
77my $Mode;
78
79($Mode, $progressJobs) = @ARGV;
80
81my $sleepdelay;
82my $failFile = $Config->get("WorkingDirectory") . "/failurecount.txt";
83if (open(FAILFILE, "<", $failFile))
84{
85    $sleepdelay = <FAILFILE>;
86    chomp $sleepdelay;
87    close FAILFILE;
88}
89elsif (open(FAILFILE, ">", $failFile))
90{
91    $sleepdelay = 0; 
92    print FAILFILE $sleepdelay;
93    close FAILFILE;
94}
95else
96{
97    die("can't open $failFile");
98
99}
100
101# Upload any ZIP files which are still waiting to go. This is the main part.
102processOldZips();
103
104## update the failFile with current failure count from processOldZips
105
106if (open(FAILFILE, ">", $failFile))
107{
108    print FAILFILE $sleepdelay;
109    close FAILFILE;
110}
111
112### end main
113###-------------------------------------------------------------------------
114
115sub processOldZips
116{
117    my $MaxDelay;
118    my @zipfiles;
119    if(opendir(ZIPDIR, $ZipDir))
120    {
121        $progress = 0;
122        $progressPercent = 0;
123        @zipfiles = grep { /\.zip$/ } readdir(ZIPDIR);
124        close ZIPDIR;
125    }
126    else 
127    {
128        return 0;
129    }
130    @sorted = sort { $a cmp $b } @zipfiles; # sort by ASCII value (i.e. upload oldest first if timestamps used)
131    my $zipCount = scalar(@sorted);
132    statusMessage(scalar(@sorted)." zip files to upload",0,0);
133    my $Reason = "queue full";
134    if(($Config->get("UploadToDirectory")) and (-d $Config->get("UploadTargetDirectory")))
135    {
136        $MaxDelay = 30; ## uploading to a local directory is a lot less costly than checking the tileserver.
137    }
138    else
139    {
140        $MaxDelay = 600;
141    }
142    while(my $File = shift @sorted)
143    {
144        # get a file handle, then try to lock the file exclusively.
145        # if open fails (file has been uploaded and removed by other process)
146        # the subsequent flock will also fail and skip the file.
147        # if just flock fails it is being handled by a different upload process
148        open (ZIPFILE, "$ZipDir/$File");
149        if (flock(ZIPFILE, LOCK_EX|LOCK_NB))
150        {   # got exclusive lock, now upload
151
152            my $FailureMode = 0; # 0 ->hard failure (i.e. Err503 on upload),
153                                 # 1 ->no failure,
154                                 # 10..1000 ->soft failure (with load% * 10)
155            # while not upload success or complete failure
156            while ($FailureMode != 1)
157            {
158                $FailureMode = upload("$ZipDir/$File");
159
160                if ($FailureMode >= 10) # 10 is 1% of 1000, which is the minimum resolution of the server return value
161                {
162                    $sleepdelay = 4  if ($sleepdelay < 4);
163                    $sleepdelay = 1.25 * $sleepdelay * (1.25 * ($FailureMode/1000)); ## 1.25 * 0.8 = 1 -> try to keep the queue at 80% full, if more increase sleepdelay by 25% plus the amount the queue is too full.
164                    $Reason = "queue full";
165                }
166                elsif ($FailureMode == 1) ## success
167                {
168                    $sleepdelay = 0.75 * $sleepdelay; # reduce sleepdelay by 25%
169                    $Reason = "uploaded ".$File;
170                    $progress++;
171                    $progressPercent = $progress * 100 / $zipCount;
172                }
173                elsif ($FailureMode == 0) ## hard fail
174                {
175                    $sleepdelay = int($sleepdelay) + 1; 
176                    last;
177                }
178
179                if ($sleepdelay > $MaxDelay)
180                {
181                    $sleepdelay = $MaxDelay;
182                }
183
184                talkInSleep($Reason, int($sleepdelay));
185            }
186
187        }
188        else
189        {   # could not get exclusive lock, this is being handled elsewhere now
190            statusMessage("$File uploaded by different process. skipping",0,3);
191        }
192        # finally unlock zipfile and release handle
193        flock (ZIPFILE, LOCK_UN);
194        close (ZIPFILE);
195        statusMessage(scalar(@sorted)." zip files left to upload",0,3);
196       
197    }
198}
199
200#-----------------------------------------------------------------------------
201# Upload a ZIP file
202#-----------------------------------------------------------------------------
203sub upload
204{
205    my ($File) = @_;
206    my $ZipSize += -s $File;
207    my $ZipAge = -M $File;   # days since last modified
208
209    if($ZipAge > 2)
210    {
211        if($Config->get("DeleteZipFilesAfterUpload"))
212        {
213            unlink($File);
214        }
215        else
216        {
217            rename($File, $File."_overage"); 
218        }
219
220        return 0;
221    }
222
223    my $Layer;
224    if ($Config->get("UploadConfiguredLayersOnly") == 1)
225    {
226        foreach my $layer(split(/,/, $Config->get("Layers")))
227        {
228            $Layer=$Config->get($layer."_Prefix") if ($File =~ /$Config->get($layer."_Prefix")/);
229            print "\n.$Layer.\n.$layer.\n" if $Config->get("Debug");
230        }
231    }
232    else
233    {
234        $File=~m{_([^_]+)(_tileset)?\.zip}x;
235        $Layer=$1;
236    }
237    $File =~ m{_(\d+)_\d+_\d+_[^_]+(_tileset)?\.zip}x;
238    my $clientId = $1;
239    if((! $Config->get("UploadToDirectory")) or (! -d $Config->get("UploadTargetDirectory")))
240    {
241        my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 360);
242       
243        $ua->protocols_allowed( ['http'] );
244        $ua->agent("tilesAtHomeZip");
245        $ua->env_proxy();
246        push @{ $ua->requests_redirectable }, 'POST';
247       
248        my $URL = $Config->get("UploadURL");
249       
250        my $Load = UploadOkOrNot();
251       
252        if ($Load < 1000) # the server normalises to 1 (*1000) so 1000 means "queue is really full or even over-filled", so only do something if the load is less than that.
253        {
254            statusMessage("Uploading $File",0,3);
255            my $res = $ua->post($URL,
256              Content_Type => 'form-data',
257              Content => [ file => [$File],
258                           user => $Config->get("UploadUsername"),
259                           passwd => $Config->get("UploadPassword"),
260                           version => $Config->get("ClientVersion"),
261                           layer => $Layer,
262                           client_uuid => ($Mode eq "upload_loop") ? $clientId : GetClientId() ]);
263             
264            if(!$res->is_success())
265            {
266                statusMessage("ERROR",1,0);
267                statusMessage("  Error uploading $File to $URL:",1,0);
268                statusMessage("  ".$res->status_line,1,0);
269                return 0; # hard fail
270            }
271            else
272            {
273                print $res->content if ($Config->get("Debug"));
274            }
275           
276        }
277        else
278        {
279            statusMessage("Not uploading, server queue full",0,0);
280            sleep(1);
281            return $Load; #soft fail
282        }
283    }
284    else
285    {
286        ## Check "queue" length
287        my $RemoteZipFileCount = 0;
288        my $MaxQueue = 20;
289        my @QueueFiles;
290        if(opendir(UPDIR, $Config->get("UploadTargetDirectory")))
291        {
292            @QueueFiles = grep { /\.zip$/ } readdir(UPDIR);
293            close UPDIR;
294        }
295        else 
296        {
297            return 0;
298        }
299        my $QueueLength = scalar(@QueueFiles);
300        my $Load = 1000 * $QueueLength/$MaxQueue;
301        if ($Load > 900) # 95% or 100% with MaxQueue=20
302        {
303            statusMessage("Not uploading, upload directory full",0,0);
304            sleep(1);
305            return $Load;
306        }
307        else
308        {
309            my $FileName = $File;
310            $FileName =~ s|.*/||;       # Get the source filename without path
311            print "\n$File $FileName\n" if $Config->get("Debug");    #Debug info
312            copy($File,$Config->get("UploadTargetDirectory")."/".$FileName."_trans") or die "$!\n"; # copy the file over using a temporary name
313            rename($Config->get("UploadTargetDirectory")."/".$FileName."_trans", $Config->get("UploadTargetDirectory")."/".$FileName) or die "$!\n"; 
314            # rename so it can be picked up by central uploading client.
315        }
316    }
317
318    # if we didn't encounter any errors error we get here
319    if($Config->get("DeleteZipFilesAfterUpload"))
320    {
321        unlink($File);
322    }
323    else
324    {
325        rename($File, $File."_uploaded");
326    }
327
328    return 1;
329}
330
331
332#-----------------------------------------------------------
333# check the go_nogo URL and retrieve the server upload queue
334# returns the status between [0,1000] (0:empty, 1000:full)
335# returns 1000 if an error occured while fetching the load
336#-----------------------------------------------------------
337sub UploadOkOrNot
338{
339    statusMessage("Checking server queue",0,3);
340    my $ua = LWP::UserAgent->new('agent' =>'tilesAtHome');
341    my $res = $ua->get($Config->get("GoNogoURL"));
342
343    if (! $res->is_success)
344    {    # Failed to retrieve server load
345         # $res->status_line; contains result here.
346         statusMessage("Failed to retrieve server queue load. Assuming full queue.",1,0);
347         return 1000;
348   }
349    my $Load = $res->content;
350    chomp $Load;
351    $Load=1-$Load;
352    return ($Load*1000);
353}
Note: See TracBrowser for help on using the repository browser.