source: subversion/applications/rendering/tilesAtHome/lib/Upload.pm @ 11132

Last change on this file since 11132 was 11110, checked in by matthiasj, 12 years ago

move all *.pm files into lib and add lib to the library search paths

  • Property svn:executable set to *
File size: 11.3 KB
Line 
1package Upload;
2
3use warnings;
4use strict;
5use LWP::UserAgent;
6use File::Copy;
7use File::Spec;
8use Fcntl ':flock'; #import LOCK_* constants
9use English '-no_match_vars';
10use Error qw(:try);
11use tahlib;
12use TahConf;
13
14#-----------------------------------------------------------------------------
15# OpenStreetMap tiles@home, upload module
16# Takes any tiles generated, adds them into ZIP files, and uploads them
17#
18# Contact OJW on the Openstreetmap wiki for help using this program
19#-----------------------------------------------------------------------------
20# Copyright 2006, Oliver White, Dirk-Lueder Kreie, Sebastian Spaeth
21#
22# This program is free software; you can redistribute it and/or
23# modify it under the terms of the GNU General Public License
24# as published by the Free Software Foundation; either version 2
25# of the License, or (at your option) any later version.
26#
27# This program is distributed in the hope that it will be useful,
28# but WITHOUT ANY WARRANTY; without even the implied warranty of
29# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
30# GNU General Public License for more details.
31#
32# You should have received a copy of the GNU General Public License
33# along with this program; if not, write to the Free Software
34# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
35#-----------------------------------------------------------------------------
36
37
38#-------------------------------------------------------------------
39# Create a new Upload instance
40#-------------------------------------------------------------------
41sub new
42{
43    my $class = shift;
44    my $self  = {};
45
46    $self = {
47        Config  => TahConf->getConfig(),
48    };
49    $self->{TileDir} = $self->{Config}->get("WorkingDirectory"),
50    $self->{ZipDir}  = File::Spec->catdir($self->{Config}->get("WorkingDirectory"), "/uploadable"),
51
52    bless ($self, $class);
53
54    $self->{sleepdelay} = ::getFault('upload') * 10;
55    # uploading to a local directory is less costly
56    $self->{MaxSleep} = $self->{Config}->get("UploadToDirectory") ? 30 : 600;
57
58    #set global progressbar task
59    $::currentSubTask ='upload';
60    return $self;
61}
62
63
64
65#-------------------------------------------------------------------
66# Returns number of uploaded zip files.
67#-------------------------------------------------------------------
68sub uploadAllZips
69{
70    my $self = shift;
71    my $Config = $self->{Config};
72    my $uploaded = 0; # num handled files
73    $::progressPercent = 0;
74    my $LOCKFILE;
75
76    if ($Config->get("LocalSlippymap"))
77    {
78        throw UploadError "No upload - LocalSlippymap set in config file";
79    }
80
81    # read in all the zip files in ZipDir
82    my @zipfiles;
83    if (opendir(ZIPDIR, $self->{ZipDir}))
84    {
85        @zipfiles = grep { /\.zip$/ } readdir(ZIPDIR);
86        closedir ZIPDIR;
87    }
88    else 
89    {
90        throw UploadError "could not read $self->{ZipDir}";
91    }
92    my $zipCount = scalar(@zipfiles);
93
94    while(my $File = shift @zipfiles)
95    {
96        ::statusMessage((scalar(@zipfiles)+1)." zip files to upload",0,0);
97        # get a file handle, then try to lock the file exclusively.
98        # if flock fails it is being handled by a different upload process
99        # also check if the file still exists when we get to it
100        open ($LOCKFILE, '>', File::Spec->join($self->{ZipDir},$File.".lock"));
101        my $flocked = !$Config->get('flock_available')
102                      || ($LOCKFILE && flock($LOCKFILE, LOCK_EX|LOCK_NB));
103        if ($flocked && -e File::Spec->join($self->{ZipDir},$File))
104        {   # got exclusive lock, now upload
105
106            my $Load;
107            my $UploadFailedHardOrDone=0;
108            # while not upload success or complete failure
109            while ($UploadFailedHardOrDone != 1)
110            {
111                my $res_str; #stores success or error msg for status line
112                try {
113                    $Load = $self->upload($File);
114
115                    # reduce sleepdelay by 25 per cent
116                    $self->{sleepdelay} = 0.75 * $self->{sleepdelay};
117                    $res_str = "uploaded ".$File;
118                    $uploaded++;
119                    $::progressPercent = $uploaded * 100 / $zipCount;
120                    $UploadFailedHardOrDone = 1;
121                }
122                catch UploadError with {
123                    my $err = shift();
124                    if ($Load = $err->value()) { 
125                        # try to keep the queue at 80% full,
126                        # if more increase sleepdelay
127                        $self->{sleepdelay} = $self->{sleepdelay} + ($Load - 800)/10;
128                        $self->{sleepdelay} = 4  if ($self->{sleepdelay} < 4);
129                        $res_str = "queue full";
130                    }
131                    else {
132                        $err->throw();
133                    }
134                };
135
136                # Finally wait sleepdelay seconds until next upload
137                if ($self->{sleepdelay} > $self->{MaxSleep})
138                {
139                    $self->{sleepdelay} = $self->{MaxSleep};
140                }
141                ::talkInSleep($res_str, int($self->{sleepdelay}));
142            }
143
144        }
145        else
146        {   # could not get exclusive lock, this is being handled elsewhere now
147            ::statusMessage("$File uploaded by different process. skipping",0,3);
148        }
149        # finally unlock zipfile and release handle
150        if ($LOCKFILE)
151        {
152            flock ($LOCKFILE, LOCK_UN);
153            close ($LOCKFILE);
154            unlink(File::Spec->join($self->{ZipDir},$File.".lock")) if $flocked;
155        }
156    }
157    ::statusMessage("uploaded $uploaded zip files",1,3) unless $uploaded == 0;
158    return $uploaded;
159}
160
161#-----------------------------------------------------------------------------
162# Upload a ZIP file
163# Parameter (filename) is the name of a .zip file in ZipDir
164# returns: Load
165#   Load: Server queue 'fullness' between [0,1000]
166#-----------------------------------------------------------------------------
167sub upload
168{
169    my $self = shift;
170    my $FileName = shift;
171    my $File     = File::Spec->join($self->{ZipDir},$FileName);
172    my $ZipSize  = -s $File;   # zip file size
173    my $ZipAge   = -M $File;   # days since last modified
174    my $Config = $self->{Config};
175
176    # delete zips that are already older than 2 days.
177    if($ZipAge > 2)
178    {
179        if($Config->get("DeleteZipFilesAfterUpload"))
180        {
181            unlink($File);
182        }
183        else
184        {
185            rename($File, $File."_overage"); 
186        }
187
188        throw UploadError "ZIP file $File too old", "overage";
189    }
190
191    $FileName =~ m{^([^_]+)_\d+_\d+_\d+_(\d+)\.zip$};
192    my $Layer=$1;
193    my $clientId = $2;
194
195    if(! $Config->get("UploadToDirectory"))
196    {
197        my $ua = LWP::UserAgent->new(keep_alive => 1, timeout => 360);
198       
199        $ua->protocols_allowed( ['http'] );
200        $ua->agent("tilesAtHomeZip");
201        $ua->env_proxy();
202        push @{ $ua->requests_redirectable }, 'POST';
203       
204        my $URL = $Config->get("UploadURL");
205       
206        my $Load = $self->UploadOkOrNot();
207
208        # The server normalises to 1 (*1000) so 1000 means "queue is really
209        # full or even over-filled"
210        # if the load is below 500 we go for sure
211        # for higher loads we only go with a certain probaility
212        # that should stabilize the load on the server and help again burstiness
213        if ($Load < (500+rand(500))) 
214        {
215            ::statusMessage("Uploading $FileName",0,3);
216            my $res = $ua->post($URL,
217              Content_Type => 'form-data',
218              Content => [ file => [$File],
219                           user => $Config->get("UploadUsername"),
220                           passwd => $Config->get("UploadPassword"),
221                           version => $Config->get("ClientVersion"),
222                           layer => $Layer,
223                           client_uuid => ($::Mode eq "upload_loop") ? $clientId : ::GetClientId() ]);
224             
225            if(!$res->is_success())
226            {
227                ::statusMessage("ERROR",1,0);
228                ::statusMessage("  Error uploading $FileName to $URL:",1,0);
229                ::statusMessage("  ".$res->status_line,1,0);
230                ::addFault('upload');
231                throw UploadError "Error uploading $FileName to $URL: $res->status_line", "ServerError"; # hard fail
232            }
233            else
234            {
235                print $res->content if ($Config->get("Debug"));
236                ::resetFault('upload');
237            }
238           
239        }
240        else
241        {
242            ::statusMessage("Not uploading, server queue full",0,0);
243            sleep(1);
244            throw UploadError "Not uploading, server queue full", $Load; #soft fail
245        }
246    }
247    else
248    {   #Upload To Directory rather than server
249        ## Check "queue" length
250        my $RemoteZipFileCount = 0;
251        my @QueueFiles;
252        if(opendir(UPDIR, $Config->get("UploadTargetDirectory")))
253        {
254            @QueueFiles = grep { /\.zip$/ } readdir(UPDIR);
255            closedir UPDIR;
256        }
257        else 
258        {
259            throw UploadError "Can not open target directory";
260        }
261        my $QueueLength = scalar(@QueueFiles);
262        my $Load = 1000 * $QueueLength/$Config->get("UploadToDirectoryMaxQueue");
263        if ($Load > 900) # 95% or 100% with MaxQueue=20
264        {
265            ::statusMessage("Not uploading, upload directory full",0,0);
266            sleep(1);
267            throw UploadError "Not uploading, upload directory full", $Load;
268        }
269        else
270        {
271            my $tmpfile = File::Spec->join($self->{Config}->get("UploadTargetDirectory"),$FileName."_part");
272
273            ## FIXME: Don't necessarily die here
274            # copy the file over using a temporary name
275            copy($File,$tmpfile) or throw UploadError "Failed to copy file to Upload Directory: $!";
276            # rename so it can be picked up by central uploading client.
277            move($tmpfile, File::Spec->join($Config->get("UploadTargetDirectory"), $FileName)) 
278                or throw UploadError "Failed to rename file in Upload Directory: $!";
279        }
280    }
281
282    # if we didn't encounter any errors error we get here
283    if($Config->get("DeleteZipFilesAfterUpload"))
284    {
285        unlink($File);
286    }
287    else
288    {
289        rename($File, $File."_uploaded");
290    }
291
292    return 0;
293}
294
295
296#-----------------------------------------------------------
297# check the go_nogo URL and retrieve the server upload queue
298# returns the status between [0,1000] (0:empty, 1000:full)
299# returns 1000 if an error occured while fetching the load
300#-----------------------------------------------------------
301sub UploadOkOrNot
302{
303    my $self = shift;
304    my $Config = $self->{Config};
305    ::statusMessage("Checking server queue",0,3);
306    my $ua = LWP::UserAgent->new('agent' =>'tilesAtHome');
307    $ua->env_proxy();
308    my $res = $ua->get($Config->get("GoNogoURL"));
309
310    if (! $res->is_success)
311    {    # Failed to retrieve server load
312         # $res->status_line; contains result here.
313         ::statusMessage("Failed to retrieve server queue load. Assuming full queue.",1,0);
314         return 1000;
315   }
316    # Load is a float value between [0,1]
317    my $Load = $res->content;
318    chomp $Load;
319    return ($Load*1000);
320}
321
322#-----------------------------------------------------------------------------------------------------------------
323# class UploadError
324#
325# Exception to be thrown by Upload methods
326
327package UploadError;
328use base 'Error::Simple';
329
3301;
Note: See TracBrowser for help on using the repository browser.