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

Last change on this file since 6939 was 6014, checked in by deelkar, 12 years ago

comments

  • Property svn:executable set to *
File size: 10.2 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
46
47my $ZipFileCount = 0;
48
49## FIXME: this is one of the things that make upload.pl not multithread safe
50my $ZipDir = $Config{WorkingDirectory} . "/uploadable";
51
52my @sorted;
53
54# when called from tilesGen, use these for nice display
55my $progress = 0;
56my $progressPercent = 0;
57my $progressJobs = $ARGV[1];
58my $currentSubTask;
59 
60my $lastmsglen;
61
62### TODO: implement locking, this is one of the things that make upload not multithread-safe.
63my $sleepdelay;
64my $failFile = $Config{WorkingDirectory} . "/failurecount.txt";
65if (open(FAILFILE, "<", $failFile))
66{
67    $sleepdelay = <FAILFILE>;
68    chomp $sleepdelay;
69    close FAILFILE;
70}
71elsif (open(FAILFILE, ">", $failFile))
72{
73    $sleepdelay = 0; 
74    print FAILFILE $sleepdelay;
75    close FAILFILE;
76}
77
78### don't compress, this is handled from tilesGen.pl now
79
80# Upload any ZIP files which are still waiting to go
81processOldZips($ARGV[0]); # ARGV[0] is there or we would have exited in init (on or about line 32)
82
83## update the failFile with current failure count from processOldZips
84
85if (open(FAILFILE, ">", $failFile))
86{
87    print FAILFILE $sleepdelay;
88    close FAILFILE;
89}
90
91## end main
92
93sub processOldZips
94{
95    my ($runNumber) = @_;
96    my @zipfiles;
97    if(opendir(ZIPDIR, $ZipDir))
98    {
99        $currentSubTask = "upload" . $runNumber;
100        $progress = 0;
101        $progressPercent = 0;
102        @zipfiles = grep { /\.zip$/ } readdir(ZIPDIR);
103        close ZIPDIR;
104    }
105    else 
106    {
107        return 0;
108    }
109    @sorted = sort { $a cmp $b } @zipfiles; # sort by ASCII value (i.e. upload oldest first if timestamps used)
110    my $zipCount = scalar(@sorted);
111    statusMessage(scalar(@sorted)." zip files to upload", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
112    my $Reason = "queue full";
113    while(my $File = shift @sorted)
114    {
115        if($File =~ /\.zip$/i)
116        {
117           
118            my $FailureMode = 0; # 0 ->hard failure (i.e. Err503 on upload),
119                                 # 1 ->no failure,
120                                 # 10..1000 ->soft failure (with load% * 10)
121            while ($FailureMode != 1) # while not upload success or complete failure
122            {
123                $FailureMode = upload("$ZipDir/$File");
124
125                if ($FailureMode >= 10)
126                {
127                    $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.
128                    $Reason = "queue full";
129                }
130                elsif ($FailureMode == 1) ## success
131                {
132                    $sleepdelay = 0.75 * $sleepdelay; # reduce sleepdelay by 25%
133                    $Reason = "uploaded ".$File;
134                    $progress++;
135                    $progressPercent = $progress * 100 / $zipCount;
136                }
137                elsif ($FailureMode == 0) ## hard fail
138                {
139                    last;
140                }
141                $sleepdelay = int($sleepdelay) + 1; 
142                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
143                {
144                    $sleepdelay = 600; ## FIXME: since the checking of the queue is much less costly than trying to upload, need to further adapt the max delay.
145                }
146
147                statusMessage($Reason.", sleeping for " . $sleepdelay . " seconds", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
148                sleep ($sleepdelay);
149            }
150
151        }
152        statusMessage(scalar(@sorted)." zip files left to upload", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
153       
154    }
155}
156
157#-----------------------------------------------------------------------------
158# Upload a ZIP file
159#-----------------------------------------------------------------------------
160sub upload
161{
162    my ($File) = @_;
163    my $ZipSize += -s $File;
164    if($ZipSize > $Config{ZipHardLimit} * 1000 * 1000) 
165    {
166        statusMessage("zip is larger than ".$Config{ZipHardLimit}." MB, retrying as split tileset.", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,1);
167        runCommand("unzip -qj $File -d $Config{WorkingDirectory}",$PID);
168
169        if($Config{DeleteZipFilesAfterUpload})
170        {
171            unlink($File);
172        }
173        else
174        {
175            rename($File, $File."_oversized"); 
176        }
177
178        return 0;
179    }
180    my $SingleTileset = ($File =~ /_tileset\.zip/) ? 'yes' : 'no';
181   
182    my $Layer;
183    foreach my $layer(split(/,/, $Config{Layers}))
184    {
185        $Layer=$Config{"Layer.$layer.Prefix"} if ($File =~ /$Config{"Layer.$layer.Prefix"}/);
186        ## DEBUG print "\n.$Layer.\n.$layer.\n";
187    }
188   
189    if((! $Config{UploadToDirectory}) or (! -d $Config{"UploadTargetDirectory"}))
190    {
191        my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 360);
192       
193        $ua->protocols_allowed( ['http'] );
194        $ua->agent("tilesAtHomeZip");
195        $ua->env_proxy();
196        push @{ $ua->requests_redirectable }, 'POST';
197       
198        my $Password = join("|", ($Config{UploadUsername}, $Config{UploadPassword}));
199        my $URL = $Config{"UploadURL"};
200       
201        my ($UploadToken,$Load) = UploadOkOrNot();
202       
203        if ($UploadToken) 
204        {
205            statusMessage("Uploading $File", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
206            my $res = $ua->post($URL,
207              Content_Type => 'form-data',
208              Content => [ file => [$File],
209              mp => $Password,
210              version => $Config{ClientVersion},
211              single_tileset => $SingleTileset,
212              token => $UploadToken,
213              layer => $Layer ]);
214             
215            if(!$res->is_success())
216            {
217                print STDERR "ERROR\n";
218                print STDERR "  Error uploading $File to $URL:\n";
219                print STDERR "  ".$res->status_line."\n";
220                return 0; # hard fail
221            }
222            else
223            {
224                print $res->content if ($Config{Debug});
225            }
226           
227        }
228        else
229        {
230            return $Load; #soft fail
231        }
232    }
233    else
234    {
235        ## Check "queue" length
236        my $RemoteZipFileCount = 0;
237        my $MaxQueue = 20;
238        my @QueueFiles;
239        if(opendir(UPDIR, $Config{"UploadTargetDirectory"}))
240        {
241            @QueueFiles = grep { /\.zip$/ } readdir(UPDIR);
242            close UPDIR;
243        }
244        else 
245        {
246            return 0;
247        }
248        my $QueueLength = scalar(@QueueFiles);
249        my $Load = $QueueLength/$MaxQueue;
250        if ($Load > 0.7)
251        {
252            statusMessage("Not uploading, upload directory full", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
253            sleep(1);
254            return $Load * 1000;
255        }
256        else
257        {
258            my $FileName = $File;
259            $FileName =~ s|.*/||;       # Get the source filename without path
260            print "\n$File $FileName\n" if $Config{Debug};    #Debug info
261            copy($File,$Config{"UploadTargetDirectory"}."/".$FileName."_trans") or die "$!\n"; # copy the file over using a temporary name
262            rename($Config{"UploadTargetDirectory"}."/".$FileName."_trans", $Config{"UploadTargetDirectory"}."/".$FileName) or die "$!\n"; 
263            # rename so it can be picked up by central uploading client.
264        }
265    }
266
267    # if we didn't encounter any errors error we get here
268    if($Config{DeleteZipFilesAfterUpload})
269    {
270        unlink($File);
271    }
272    else
273    {
274        rename($File, $File."_uploaded");
275    }
276
277    return 1;
278}
279
280
281sub UploadOkOrNot
282{
283    my $LocalFilename = $Config{WorkingDirectory} . "/go-nogo-".$PID.".tmp";
284    statusMessage("Checking server queue", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
285    DownloadFile($Config{GoNogoURL}, $LocalFilename, 1);
286    open(my $fp, "<", $LocalFilename) || return;
287    my $Load = <$fp>; ##read first line from file
288    my $Token = <$fp>; ##read another line from file
289    chomp $Load;
290    chomp $Token;
291    close $fp;
292    killafile($LocalFilename);
293    $Load=1-$Load;
294    ##DEBUG print STDERR "\nLoad: $Load \n";
295    # $Token=1 if (! $Token);
296    if ($Load > 0.8) 
297    {
298        statusMessage("Not uploading, server queue full", $Config{Verbose}, $currentSubTask, $progressJobs, $progressPercent,0);
299        sleep(1);
300        return (0,$Load*1000);
301    }
302    else
303    {
304        #DEBUG: print STDERR "\n $Token\n";
305        return ($Token,$Load*1000);
306    }
307}
Note: See TracBrowser for help on using the repository browser.