source: trunk/base/src/package1.0/portarchivefetch.tcl @ 68965

Last change on this file since 68965 was 68965, checked in by jmr@…, 10 years ago

fix handling of distfiles with tags that have no corresponding URL (#25332)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 9.4 KB
Line 
1# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
2# $Id: portarchivefetch.tcl 68965 2010-06-18 21:53:59Z jmr@macports.org $
3#
4# Copyright (c) 2002 - 2003 Apple Inc.
5# Copyright (c) 2004-2010 The MacPorts Project
6# All rights reserved.
7#
8# Redistribution and use in source and binary forms, with or without
9# modification, are permitted provided that the following conditions
10# are met:
11# 1. Redistributions of source code must retain the above copyright
12#    notice, this list of conditions and the following disclaimer.
13# 2. Redistributions in binary form must reproduce the above copyright
14#    notice, this list of conditions and the following disclaimer in the
15#    documentation and/or other materials provided with the distribution.
16# 3. Neither the name of Apple Inc. nor the names of its contributors
17#    may be used to endorse or promote products derived from this software
18#    without specific prior written permission.
19#
20# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
24# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
25# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
26# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
28# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30# POSSIBILITY OF SUCH DAMAGE.
31#
32
33package provide portarchivefetch 1.0
34package require fetch_common 1.0
35package require portutil 1.0
36package require Pextlib 1.0
37
38set org.macports.archivefetch [target_new org.macports.archivefetch portarchivefetch::archivefetch_main]
39target_init ${org.macports.archivefetch} portarchivefetch::archivefetch_init
40target_provides ${org.macports.archivefetch} archivefetch
41target_requires ${org.macports.archivefetch} main
42target_prerun ${org.macports.archivefetch} portarchivefetch::archivefetch_start
43
44namespace eval portarchivefetch {
45    variable archivefetch_urls {}
46}
47
48options archive_sites archivefetch.user archivefetch.password \
49    archivefetch.use_epsv archivefetch.ignore_sslcert \
50    archive_sites.mirror_subdir
51
52# user name & password
53default archivefetch.user ""
54default archivefetch.password ""
55# Use EPSV for FTP transfers
56default archivefetch.use_epsv no
57# Ignore SSL certificate
58default archivefetch.ignore_sslcert no
59
60default archive_sites macports_archives
61default archive_sites.listfile {"archive_sites.tcl"}
62default archive_sites.listpath {"port1.0/fetch"}
63
64set_ui_prefix
65
66# Checks possible archive files to assemble url lists for later fetching
67proc portarchivefetch::checkarchivefiles {urls} {
68    global all_archive_files archivefetch.fulldestpath \
69           portarchivepath name version revision portvariants archive_sites
70    upvar $urls fetch_urls
71
72    # Define archive directory, file, and path
73    if {[llength [get_canonical_archs]] > 1} {
74        set archivefetch.fulldestpath [file join ${portarchivepath} [option os.platform] "universal"]
75    } else {
76        set archivefetch.fulldestpath [file join ${portarchivepath} [option os.platform] [get_canonical_archs]]
77    }
78
79    set unsupported 0
80    set found 0
81    foreach archive.type [option portarchivetype] {
82        if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
83            set archstring [join [get_canonical_archs] -]
84            set archive.file "${name}-${version}_${revision}${portvariants}.${archstring}.${archive.type}"
85            set archive.path [file join ${archivefetch.fulldestpath} ${archive.file}]
86            if {[file exists ${archive.path}]} {
87                set found 1
88                break
89            } else {
90                lappend all_archive_files ${archive.file}
91                if {[info exists archive_sites]} {
92                    lappend fetch_urls archive_sites ${archive.file}
93                }
94            }
95        } else {
96            ui_debug "Skipping [string toupper ${archive.type}] archive: $errmsg"
97            incr unsupported
98        }
99    }
100    if {$found} {
101        ui_debug "Found [string toupper ${archive.type}] archive: ${archive.path}"
102        set all_archive_files {}
103        set fetch_urls {}
104    } elseif {[llength [option portarchivetype]] == $unsupported} {
105        return -code error "Unable to fetch archive ($name) since specified archive types not supported"
106    }
107}
108
109# returns full path to mirror list file
110proc portarchivefetch::get_full_archive_sites_path {} {
111    global archive_sites.listfile archive_sites.listpath porturl
112    return [getportresourcepath $porturl [file join ${archive_sites.listpath} ${archive_sites.listfile}]]
113}
114
115# Perform the full checksites/checkarchivefiles sequence.
116proc portarchivefetch::checkfiles {urls} {
117    upvar $urls fetch_urls
118
119    portfetch::checksites [list archive_sites [list {} {} ARCHIVE_SITE_LOCAL]] \
120                          [get_full_archive_sites_path]
121    checkarchivefiles fetch_urls
122}
123
124
125# Perform a standard fetch, assembling fetch urls from
126# the listed url variable and associated archive file
127proc portarchivefetch::fetchfiles {args} {
128    global archivefetch.fulldestpath UI_PREFIX
129    global archivefetch.user archivefetch.password archivefetch.use_epsv \
130           archivefetch.ignore_sslcert
131    global portverbose ports_binary_only
132    variable archivefetch_urls
133    variable ::portfetch::urlmap
134
135    if {![file isdirectory ${archivefetch.fulldestpath}]} {
136        if {[catch {file mkdir ${archivefetch.fulldestpath}} result]} {
137            elevateToRoot "archivefetch"
138            set elevated yes
139            if {[catch {file mkdir ${archivefetch.fulldestpath}} result]} {
140                return -code error [format [msgcat::mc "Unable to create archive path: %s"] $result]
141            }
142        }
143    }
144    chownAsRoot ${archivefetch.fulldestpath}
145    if {[info exists elevated] && $elevated == yes} {
146        dropPrivileges
147    }
148
149    set fetch_options {}
150    if {[string length ${archivefetch.user}] || [string length ${archivefetch.password}]} {
151        lappend fetch_options -u
152        lappend fetch_options "${archivefetch.user}:${archivefetch.password}"
153    }
154    if {${archivefetch.use_epsv} != "yes"} {
155        lappend fetch_options "--disable-epsv"
156    }
157    if {${archivefetch.ignore_sslcert} != "no"} {
158        lappend fetch_options "--ignore-ssl-cert"
159    }
160    if {$portverbose == "yes"} {
161        lappend fetch_options "-v"
162    }
163    set sorted no
164
165    foreach {url_var archive} $archivefetch_urls {
166        if {![file isfile ${archivefetch.fulldestpath}/${archive}]} {
167            ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $archive ${archivefetch.fulldestpath}]"
168            if {![file writable ${archivefetch.fulldestpath}]} {
169                return -code error [format [msgcat::mc "%s must be writable"] ${archivefetch.fulldestpath}]
170            }
171            if {!$sorted} {
172                portfetch::sortsites archivefetch_urls {} archive_sites
173                set sorted yes
174            }
175            if {![info exists urlmap($url_var)]} {
176                ui_error [format [msgcat::mc "No defined site for tag: %s, using archive_sites"] $url_var]
177                set urlmap($url_var) $urlmap(archive_sites)
178            }
179            unset -nocomplain fetched
180            foreach site $urlmap($url_var) {
181                ui_msg "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] $archive $site]"
182                set file_url [portfetch::assemble_url $site $archive]
183                set effectiveURL ""
184                if {![catch {eval curl fetch --effective-url effectiveURL $fetch_options {$file_url} ${archivefetch.fulldestpath}/${archive}.TMP} result] &&
185                    ![catch {file rename -force "${archivefetch.fulldestpath}/${archive}.TMP" "${archivefetch.fulldestpath}/${archive}"} result]} {
186                    # Successful fetch
187                    set fetched 1
188                    break
189                } else {
190                    ui_debug "[msgcat::mc "Fetching archive failed:"]: $result"
191                    file delete -force "${archivefetch.fulldestpath}/${archive}.TMP"
192                }
193            }
194            if {[info exists fetched]} {
195                return 0
196            }
197        } else {
198            return 0
199        }
200    }
201    if {[info exists ports_binary_only] && $ports_binary_only == "yes"} {
202        return -code error "archivefetch failed for [option name] @[option version]_[option revision][option portvariants]"
203    } else {
204        return 0
205    }
206}
207
208# Initialize archivefetch target and call checkfiles.
209proc portarchivefetch::archivefetch_init {args} {
210    variable archivefetch_urls
211
212    if {[option portarchivemode] != "yes"} {
213        return -code error "Archive mode is not enabled!"
214    }
215
216    portarchivefetch::checkfiles archivefetch_urls
217}
218
219proc portarchivefetch::archivefetch_start {args} {
220    global UI_PREFIX name
221
222    ui_msg "$UI_PREFIX [format [msgcat::mc "Fetching archive for %s"] $name]"
223}
224
225# Main archive fetch routine
226# just calls the standard fetchfiles procedure
227proc portarchivefetch::archivefetch_main {args} {
228    global all_archive_files
229    if {[info exists all_archive_files] && [llength $all_archive_files] > 0} {
230        # Fetch the files
231        return [portarchivefetch::fetchfiles]
232    }
233}
Note: See TracBrowser for help on using the repository browser.