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

Revision 3859, 8.8 KB checked in by deelkar, 7 years ago (diff)

make ZIPDIR a local handle to sub processOldZips

  • Property svn:executable set to *
Line 
1#!/usr/bin/perl
2use strict;
3use FindBin qw($Bin);
4use LWP::UserAgent;
5use File::Copy;
6use English '-no_match_vars';
7use tahconfig;
8use tahlib;
9#-----------------------------------------------------------------------------
10# OpenStreetMap tiles@home, upload module
11# Takes any tiles generated, adds them into ZIP files, and uploads them
12#
13# Contact OJW on the Openstreetmap wiki for help using this program
14#-----------------------------------------------------------------------------
15# Copyright 2006, Oliver White
16#
17# This program is free software; you can redistribute it and/or
18# modify it under the terms of the GNU General Public License
19# as published by the Free Software Foundation; either version 2
20# of the License, or (at your option) any later version.
21#
22# This program is distributed in the hope that it will be useful,
23# but WITHOUT ANY WARRANTY; without even the implied warranty of
24# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
25# GNU General Public License for more details.
26#
27# You should have received a copy of the GNU General Public License
28# along with this program; if not, write to the Free Software
29# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
30#-----------------------------------------------------------------------------
31
32# conf file, will contain username/password and environment info
33my %Config = ReadConfig("tilesAtHome.conf", "general.conf", "authentication.conf", "layers.conf");
34
35if ($Config{"LocalSlippymap"})
36{
37    print "No upload - LocalSlippymap set in config file\n";
38    exit 1;
39}
40
41my $ZipFileCount = 0;
42
43## FIXME: this is one of the things that make upload.pl not multithread safe
44my $ZipDir = $Config{WorkingDirectory} . "/uploadable";
45
46my @sorted;
47
48# when called from tilesGen, use these for nice display
49my $progress = 0;
50my $progressPercent = 0;
51my $progressJobs = $ARGV[0] or 1;
52my $currentSubTask;
53 
54my $lastmsglen;
55
56### TODO: implement locking, this is one of the things that make upload not multithread-safe.
57my $sleepdelay;
58my $failFile = $Config{WorkingDirectory} . "/failurecount.txt";
59if (open(FAILFILE, "<", $failFile))
60{
61    $sleepdelay = <FAILFILE>;
62    chomp $sleepdelay;
63    close FAILFILE;
64}
65elsif (open(FAILFILE, ">", $failFile))
66{
67    $sleepdelay = 0; 
68    print FAILFILE $sleepdelay;
69    close FAILFILE;
70}
71
72compress(1); ## first run
73
74# Upload any ZIP files which are still waiting to go
75processOldZips(1);
76
77# We might have created lots of single tiles if some tileset zips were larger than 10 MB, so re-check here
78compress(2); ## second (and last) run.
79
80# Do we have new zips? (try to) upload them all!
81processOldZips(2);
82
83
84## update the failFile with current failure count from processOldZips
85
86if (open(FAILFILE, ">", $failFile))
87{
88    print FAILFILE $sleepdelay;
89    close FAILFILE;
90}
91
92## end main
93
94sub processOldZips
95{
96    if(opendir(ZIPDIR, $ZipDir))
97    {
98        my ($runNumber) = @_;
99        $currentSubTask = "upload" . $runNumber;
100        $progress = 0;
101        my @zipfiles = grep { /\.zip$/ } readdir(ZIPDIR);
102        close ZIPDIR;
103    }
104    else 
105    {
106        return 0;
107    }
108    @sorted = sort { $a cmp $b } @zipfiles; # sort by ASCII value (i.e. upload oldest first if timestamps used)
109    my $zipCount = scalar(@sorted);
110    statusMessage(scalar(@sorted)." zip files to upload", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
111    my $Reason = "queue full";
112    while(my $File = shift @sorted)
113    {
114        if($File =~ /\.zip$/i)
115        {
116           
117            my $FailureMode = 0; # 0 ->hard failure (i.e. Err503 on upload),
118                                 # 1 ->no failure,
119                                 # 10..1000 ->soft failure (with load% * 10)
120            while ($FailureMode != 1) # while not upload success or complete failure
121            {
122                $FailureMode = upload("$ZipDir/$File");
123
124                if ($FailureMode >= 10)
125                {
126                    $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.
127                    $Reason = "queue full";
128                }
129                elsif ($FailureMode == 1) ## success
130                {
131                    $sleepdelay = 0.75 * $sleepdelay; # reduce sleepdelay by 25%
132                    $Reason = "uploaded ".$File;
133                }
134                elsif ($FailureMode == 0) ## hard fail
135                {
136                    last;
137                }
138                $sleepdelay = int($sleepdelay) + 1; 
139                if ($sleepdelay > 600)  ## needs adjusting based on real-world experience, if this check is true the above load adapting failed and the server is too overloaded to reasonably process the queue relative to the rendering speed
140                {
141                    $sleepdelay = 600; ## FIXME: since the checking of the queue is much less costly than trying to upload, need to further adapt the max delay.
142                }
143
144                statusMessage($Reason.", sleeping for " . $sleepdelay . " seconds", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
145                sleep ($sleepdelay);
146            }
147
148        }
149        $progress++;
150        $progressPercent = $progress * 100 / $zipCount;
151        statusMessage(scalar(@sorted)." zip files left to upload", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
152       
153    }
154}
155
156#-----------------------------------------------------------------------------
157# Upload a ZIP file
158#-----------------------------------------------------------------------------
159sub upload
160{
161    my ($File) = @_;
162    my $ZipSize += -s $File;
163    if($ZipSize > $Config{ZipHardLimit} * 1000 * 1000) 
164    {
165        statusMessage("zip is larger than ".$Config{ZipHardLimit}." MB, retrying as split tileset.", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,1);
166        runCommand("unzip -qj $File -d $Config{WorkingDirectory}",$PID);
167
168        if($Config{DeleteZipFilesAfterUpload})
169        {
170            unlink($File);
171        }
172        else
173        {
174            rename($File, $File."_oversized"); 
175        }
176
177        return 0;
178    }
179    my $SingleTileset = ($File =~ /_tileset\.zip/) ? 'yes' : 'no';
180   
181    my $Layer;
182    foreach my $layer(split(/,/, $Config{Layers}))
183    {
184        $Layer=$Config{"Layer.$layer.Prefix"} if ($File =~ /$Config{"Layer.$layer.Prefix"}/);
185        ## DEBUG print "\n.$Layer.\n.$layer.\n";
186    }
187   
188    my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 360);
189
190    $ua->protocols_allowed( ['http'] );
191    $ua->agent("tilesAtHomeZip");
192    $ua->env_proxy();
193   
194    my $Password = join("|", ($Config{UploadUsername}, $Config{UploadPassword}));
195    my $URL = $Config{"UploadURL2"};
196   
197    my ($UploadToken,$Load) = UploadOkOrNot();
198   
199    if ($UploadToken) 
200    {
201        statusMessage("Uploading $File", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
202        my $res = $ua->post($URL,
203          Content_Type => 'form-data',
204          Content => [ file => [$File],
205          mp => $Password,
206          version => $Config{ClientVersion},
207          single_tileset => $SingleTileset,
208          token => $UploadToken,
209          layer => $Layer ]);
210     
211        if(!$res->is_success())
212        {
213            print STDERR "ERROR\n";
214            print STDERR "  Error uploading $File to $URL:\n";
215            print STDERR "  ".$res->status_line."\n";
216            return 0; # hard fail
217        } 
218   
219        if($Config{DeleteZipFilesAfterUpload})
220        {
221            unlink($File);
222        }
223        else
224        {
225            rename($File, $File."_uploaded");
226        }
227    }
228    else
229    {
230        return $Load; #soft fail
231    }
232   
233    return 1;
234}
235
236sub compress
237{
238    ## Run compress directly because it uses same messaging as tilesGen.pl and upload.pl
239    ## no need to hide output at all.
240
241    my ($runNumber) = @_;
242
243    my $UploadScript = "$Bin/compress.pl $runNumber $progressJobs";
244    my $retval = system($UploadScript);
245    return $retval;
246}
247
248
249sub UploadOkOrNot
250{
251    my $LocalFilename = $Config{WorkingDirectory} . "/go-nogo-".$PID.".tmp";
252    statusMessage("Checking server queue", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
253    DownloadFile($Config{GoNogoURL}, $LocalFilename, 1);
254    open(my $fp, "<", $LocalFilename) || return;
255    my $Load = <$fp>; ##read first line from file
256    my $Token = <$fp>; ##read another line from file
257    chomp $Load;
258    chomp $Token;
259    close $fp;
260    killafile($LocalFilename);
261    $Load=1-$Load;
262    ##DEBUG print STDERR "\nLoad: $Load \n";
263    # $Token=1 if (! $Token);
264    if ($Load > 0.8) 
265    {
266        statusMessage("Not uploading, server queue full", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
267        sleep(1);
268        return (0,$Load*1000);
269    }
270    else
271    {
272        #DEBUG: print STDERR "\n $Token\n";
273        return ($Token,$Load*1000);
274    }
275}
Note: See TracBrowser for help on using the repository browser.