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

Last change on this file since 5992 was 5697, checked in by deelkar, 12 years ago

make the process % correct on upload

  • Property svn:executable set to *
File size: 8.7 KB
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, Dirk-Lueder Kreie
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
32if (not $ARGV[0]) 
33{
34   die "please call \"tilesGen.pl upload\" instead";
35}
36
37# conf file, will contain username/password and environment info
38my %Config = ReadConfig("tilesAtHome.conf", "general.conf", "authentication.conf", "layers.conf");
39
40if ($Config{"LocalSlippymap"})
41{
42    print "No upload - LocalSlippymap set in config file\n";
43    exit 1;
44}
45
46my $ZipFileCount = 0;
47
48## FIXME: this is one of the things that make upload.pl not multithread safe
49my $ZipDir = $Config{WorkingDirectory} . "/uploadable";
50
51my @sorted;
52
53# when called from tilesGen, use these for nice display
54my $progress = 0;
55my $progressPercent = 0;
56my $progressJobs = $ARGV[1];
57my $currentSubTask;
58 
59my $lastmsglen;
60
61### TODO: implement locking, this is one of the things that make upload not multithread-safe.
62my $sleepdelay;
63my $failFile = $Config{WorkingDirectory} . "/failurecount.txt";
64if (open(FAILFILE, "<", $failFile))
65{
66    $sleepdelay = <FAILFILE>;
67    chomp $sleepdelay;
68    close FAILFILE;
69}
70elsif (open(FAILFILE, ">", $failFile))
71{
72    $sleepdelay = 0; 
73    print FAILFILE $sleepdelay;
74    close FAILFILE;
75}
76
77### don't compress, this is handled from tilesGen.pl now
78
79# Upload any ZIP files which are still waiting to go
80processOldZips($ARGV[0]); # ARGV[0] is there or we would have exited in init (on or about line 32)
81
82## update the failFile with current failure count from processOldZips
83
84if (open(FAILFILE, ">", $failFile))
85{
86    print FAILFILE $sleepdelay;
87    close FAILFILE;
88}
89
90## end main
91
92sub processOldZips
93{
94    my ($runNumber) = @_;
95    my @zipfiles;
96    if(opendir(ZIPDIR, $ZipDir))
97    {
98        $currentSubTask = "upload" . $runNumber;
99        $progress = 0;
100        $progressPercent = 0;
101        @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                    $progress++;
134                    $progressPercent = $progress * 100 / $zipCount;
135                }
136                elsif ($FailureMode == 0) ## hard fail
137                {
138                    last;
139                }
140                $sleepdelay = int($sleepdelay) + 1; 
141                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
142                {
143                    $sleepdelay = 600; ## FIXME: since the checking of the queue is much less costly than trying to upload, need to further adapt the max delay.
144                }
145
146                statusMessage($Reason.", sleeping for " . $sleepdelay . " seconds", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
147                sleep ($sleepdelay);
148            }
149
150        }
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    push @{ $ua->requests_redirectable }, 'POST';
194
195    my $Password = join("|", ($Config{UploadUsername}, $Config{UploadPassword}));
196    my $URL = $Config{"UploadURL"};
197   
198    my ($UploadToken,$Load) = UploadOkOrNot();
199   
200    if ($UploadToken) 
201    {
202        statusMessage("Uploading $File", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
203        my $res = $ua->post($URL,
204          Content_Type => 'form-data',
205          Content => [ file => [$File],
206          mp => $Password,
207          version => $Config{ClientVersion},
208          single_tileset => $SingleTileset,
209          token => $UploadToken,
210          layer => $Layer ]);
211     
212        if(!$res->is_success())
213        {
214            print STDERR "ERROR\n";
215            print STDERR "  Error uploading $File to $URL:\n";
216            print STDERR "  ".$res->status_line."\n";
217            return 0; # hard fail
218        }
219        else
220        {
221            print $res->content if ($Config{Debug});
222        }
223
224        if($Config{DeleteZipFilesAfterUpload})
225        {
226            unlink($File);
227        }
228        else
229        {
230            rename($File, $File."_uploaded");
231        }
232    }
233    else
234    {
235        return $Load; #soft fail
236    }
237   
238    return 1;
239}
240
241
242sub UploadOkOrNot
243{
244    my $LocalFilename = $Config{WorkingDirectory} . "/go-nogo-".$PID.".tmp";
245    statusMessage("Checking server queue", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
246    DownloadFile($Config{GoNogoURL}, $LocalFilename, 1);
247    open(my $fp, "<", $LocalFilename) || return;
248    my $Load = <$fp>; ##read first line from file
249    my $Token = <$fp>; ##read another line from file
250    chomp $Load;
251    chomp $Token;
252    close $fp;
253    killafile($LocalFilename);
254    $Load=1-$Load;
255    ##DEBUG print STDERR "\nLoad: $Load \n";
256    # $Token=1 if (! $Token);
257    if ($Load > 0.8) 
258    {
259        statusMessage("Not uploading, server queue full", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
260        sleep(1);
261        return (0,$Load*1000);
262    }
263    else
264    {
265        #DEBUG: print STDERR "\n $Token\n";
266        return ($Token,$Load*1000);
267    }
268}
Note: See TracBrowser for help on using the repository browser.