source: branches/gsoc13-tests/src/package1.0/portarchivefetch.tcl @ 139170

Last change on this file since 139170 was 111323, checked in by marius@…, 7 years ago

Merge from trunk.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.5 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 111323 2013-09-18 23:11:02Z marius@macports.org $
3#
4# Copyright (c) 2002 - 2003 Apple Inc.
5# Copyright (c) 2004 - 2013 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]
39#target_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 archivefetch.pubkeys \
51    archive.subdir
52
53# user name & password
54default archivefetch.user ""
55default archivefetch.password ""
56# Use EPSV for FTP transfers
57default archivefetch.use_epsv no
58# Ignore SSL certificate
59default archivefetch.ignore_sslcert no
60default archivefetch.pubkeys {$archivefetch_pubkeys}
61
62default archive_sites {[portarchivefetch::filter_sites]}
63default archive_sites.listfile {"archive_sites.tcl"}
64default archive_sites.listpath {"port1.0/fetch"}
65default archive.subdir {${subport}}
66
67proc portarchivefetch::filter_sites {} {
68    global prefix frameworks_dir applications_dir porturl \
69        portfetch::mirror_sites::sites portfetch::mirror_sites::archive_type \
70        portfetch::mirror_sites::archive_prefix \
71        portfetch::mirror_sites::archive_frameworks_dir \
72        portfetch::mirror_sites::archive_applications_dir
73
74    # get defaults from ports tree resources
75    set mirrorfile [get_full_archive_sites_path]
76    if {[file exists $mirrorfile]} {
77        source $mirrorfile
78    }
79    # get archive_sites.conf values
80    foreach {key val} [get_archive_sites_conf_values] {
81        set $key $val
82    }
83
84    set ret {}
85    foreach site [array names portfetch::mirror_sites::archive_prefix] {
86        set missing 0
87        foreach var {archive_frameworks_dir archive_applications_dir archive_type} {
88            if {![info exists portfetch::mirror_sites::${var}($site)]} {
89                ui_warn "no $var configured for site '$site'"
90                set missing 1
91            }
92        }
93        if {$missing} {
94            continue
95        }
96        if {$portfetch::mirror_sites::sites($site) ne {} &&
97            $portfetch::mirror_sites::archive_prefix($site) == $prefix &&
98            $portfetch::mirror_sites::archive_frameworks_dir($site) == $frameworks_dir &&
99            $portfetch::mirror_sites::archive_applications_dir($site) == $applications_dir &&
100            ![catch {archiveTypeIsSupported $portfetch::mirror_sites::archive_type($site)}]} {
101            # using the archive type as a tag
102            lappend ret ${site}::$portfetch::mirror_sites::archive_type($site)
103        }
104    }
105
106    # check if porturl itself points to an archive
107    if {[file rootname [file tail $porturl]] == [file rootname [get_portimage_name]] && [file extension $porturl] != ""} {
108        lappend ret [string range $porturl 0 end-[string length [file tail $porturl]]]:[string range [file extension $porturl] 1 end]
109        archive.subdir
110    }
111    return $ret
112}
113
114set_ui_prefix
115
116# Checks possible archive files to assemble url lists for later fetching
117proc portarchivefetch::checkarchivefiles {urls} {
118    global all_archive_files archivefetch.fulldestpath archive_sites
119    upvar $urls fetch_urls
120
121    # Define archive directory path
122    set archivefetch.fulldestpath [file join [option portdbpath] incoming/verified]
123    set archive.rootname [file rootname [get_portimage_name]]
124
125    foreach entry [option archive_sites] {
126        # the archive type is used as a tag
127        set type [lindex [split $entry :] end]
128        if {![info exists seen($type)]} {
129            set archive.file "${archive.rootname}.${type}"
130            lappend all_archive_files ${archive.file}
131            lappend fetch_urls $type ${archive.file}
132            set seen($type) 1
133        }
134    }
135}
136
137# returns full path to mirror list file
138proc portarchivefetch::get_full_archive_sites_path {} {
139    global archive_sites.listfile archive_sites.listpath porturl
140    return [getportresourcepath $porturl [file join ${archive_sites.listpath} ${archive_sites.listfile}]]
141}
142
143# Perform the full checksites/checkarchivefiles sequence.
144proc portarchivefetch::checkfiles {urls} {
145    upvar $urls fetch_urls
146
147    portfetch::checksites [list archive_sites [list {} {} ARCHIVE_SITE_LOCAL]] \
148                          [get_full_archive_sites_path]
149    checkarchivefiles fetch_urls
150}
151
152
153# Perform a standard fetch, assembling fetch urls from
154# the listed url variable and associated archive file
155proc portarchivefetch::fetchfiles {args} {
156    global archivefetch.fulldestpath UI_PREFIX \
157           archivefetch.user archivefetch.password archivefetch.use_epsv \
158           archivefetch.ignore_sslcert \
159           portverbose ports_binary_only
160    variable archivefetch_urls
161    variable ::portfetch::urlmap
162
163    if {![file isdirectory ${archivefetch.fulldestpath}]} {
164        if {[catch {file mkdir ${archivefetch.fulldestpath}} result]} {
165            elevateToRoot "archivefetch"
166            set elevated yes
167            if {[catch {file mkdir ${archivefetch.fulldestpath}} result]} {
168                return -code error [format [msgcat::mc "Unable to create archive path: %s"] $result]
169            }
170        }
171    }
172    set incoming_path [file join [option portdbpath] incoming]
173    chownAsRoot $incoming_path
174    if {[info exists elevated] && $elevated == yes} {
175        dropPrivileges
176    }
177
178    set fetch_options {}
179    if {[string length ${archivefetch.user}] || [string length ${archivefetch.password}]} {
180        lappend fetch_options -u
181        lappend fetch_options "${archivefetch.user}:${archivefetch.password}"
182    }
183    if {${archivefetch.use_epsv} != "yes"} {
184        lappend fetch_options "--disable-epsv"
185    }
186    if {${archivefetch.ignore_sslcert} != "no"} {
187        lappend fetch_options "--ignore-ssl-cert"
188    }
189    if {$portverbose == "yes"} {
190        lappend fetch_options "-v"
191    }
192    set sorted no
193
194    set existing_archive [find_portarchive_path]
195
196    foreach {url_var archive} $archivefetch_urls {
197        if {![file isfile ${archivefetch.fulldestpath}/${archive}] && $existing_archive == ""} {
198            ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $archive ${archivefetch.fulldestpath}]"
199            if {![file writable ${archivefetch.fulldestpath}]} {
200                return -code error [format [msgcat::mc "%s must be writable"] ${archivefetch.fulldestpath}]
201            }
202            if {![file writable $incoming_path]} {
203                return -code error [format [msgcat::mc "%s must be writable"] $incoming_path]
204            }
205            if {!$sorted} {
206                portfetch::sortsites archivefetch_urls {} archive_sites
207                set sorted yes
208            }
209            if {![info exists urlmap($url_var)]} {
210                ui_error [format [msgcat::mc "No defined site for tag: %s, using archive_sites"] $url_var]
211                set urlmap($url_var) $urlmap(archive_sites)
212            }
213            set failed_sites 0
214            unset -nocomplain fetched
215            foreach site $urlmap($url_var) {
216                if {[string index $site end] != "/"} {
217                    append site "/[option archive.subdir]"
218                } else {
219                    append site [option archive.subdir]
220                }
221                ui_msg "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] $archive ${site}]"
222                set file_url [portfetch::assemble_url $site $archive]
223                set effectiveURL ""
224                if {![catch {eval curl fetch --effective-url effectiveURL $fetch_options {$file_url} {"${incoming_path}/${archive}.TMP"}} result]} {
225                    # Successful fetch
226                    set fetched 1
227                    break
228                } else {
229                    ui_debug "[msgcat::mc "Fetching archive failed:"]: $result"
230                    file delete -force "${incoming_path}/${archive}.TMP"
231                    incr failed_sites
232                    if {$failed_sites > 2 && ![tbool ports_binary_only] && ![_archive_available]} {
233                        break
234                    }
235                }
236            }
237            if {[info exists fetched]} {
238                # there should be an rmd160 digest of the archive signed with one of the trusted keys
239                set signature "${incoming_path}/${archive}.rmd160"
240                ui_msg "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] ${archive}.rmd160 $site]"
241                # reusing $file_url from the last iteration of the loop above
242                if {[catch {eval curl fetch --effective-url effectiveURL $fetch_options {${file_url}.rmd160} {$signature}} result]} {
243                    ui_debug "$::errorInfo"
244                    return -code error "Failed to fetch signature for archive: $result"
245                }
246                set openssl [findBinary openssl $portutil::autoconf::openssl_path]
247                set verified 0
248                foreach pubkey [option archivefetch.pubkeys] {
249                    if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature "${incoming_path}/${archive}.TMP"} result]} {
250                        set verified 1
251                        break
252                    } else {
253                        ui_debug "failed verification with key $pubkey"
254                        ui_debug "openssl output: $result"
255                    }
256                }
257                file delete -force $signature
258                if {!$verified} {
259                    # fall back to building from source (or error out later if binary only mode)
260                    ui_warn "Failed to verify signature for archive!"
261                    file delete -force "${incoming_path}/${archive}.TMP"
262                    break
263                } elseif {[catch {file rename -force "${incoming_path}/${archive}.TMP" "${archivefetch.fulldestpath}/${archive}"} result]} {
264                    ui_debug "$::errorInfo"
265                    return -code error "Failed to move downloaded archive into place: $result"
266                }
267                set archive_exists 1
268                break
269            }
270        } else {
271            set archive_exists 1
272            break
273        }
274    }
275    if {[info exists archive_exists]} {
276        # modify state file to skip remaining phases up to destroot
277        global target_state_fd
278        foreach target {fetch checksum extract patch configure build destroot} {
279            write_statefile target "org.macports.${target}" $target_state_fd
280        }
281        return 0
282    }
283    if {[info exists ports_binary_only] && $ports_binary_only == "yes"} {
284        return -code error "archivefetch failed for [option subport] @[option version]_[option revision][option portvariants]"
285    } else {
286        return 0
287    }
288}
289
290# Initialize archivefetch target and call checkfiles.
291#proc portarchivefetch::archivefetch_init {args} {
292#    return 0
293#}
294
295proc portarchivefetch::archivefetch_start {args} {
296    variable archivefetch_urls
297    global UI_PREFIX subport all_archive_files destroot target_state_fd \
298           ports_source_only ports_binary_only
299    if {![tbool ports_source_only] && ([tbool ports_binary_only] ||
300            !([check_statefile target org.macports.destroot $target_state_fd] && [file isdirectory $destroot]))} {
301        portarchivefetch::checkfiles archivefetch_urls
302    }
303    if {[info exists all_archive_files] && [llength $all_archive_files] > 0} {
304        ui_msg "$UI_PREFIX [format [msgcat::mc "Fetching archive for %s"] $subport]"
305    }
306    portfetch::check_dns
307}
308
309# Main archive fetch routine
310# just calls the standard fetchfiles procedure
311proc portarchivefetch::archivefetch_main {args} {
312    global all_archive_files
313    if {[info exists all_archive_files] && [llength $all_archive_files] > 0} {
314        # Fetch the files
315        portarchivefetch::fetchfiles
316    }
317    return 0
318}
Note: See TracBrowser for help on using the repository browser.