[64816] trunk/base/src

jmr at macports.org jmr at macports.org
Mon Mar 15 21:42:57 PDT 2010


Revision: 64816
          http://trac.macports.org/changeset/64816
Author:   jmr at macports.org
Date:     2010-03-15 21:42:56 -0700 (Mon, 15 Mar 2010)
Log Message:
-----------
add archivefetch target (#8571)

Modified Paths:
--------------
    trunk/base/src/package1.0/Makefile
    trunk/base/src/package1.0/package.tcl
    trunk/base/src/package1.0/portarchive.tcl
    trunk/base/src/package1.0/portpkg.tcl
    trunk/base/src/package1.0/portunarchive.tcl
    trunk/base/src/port/port-help.tcl
    trunk/base/src/port/port.tcl
    trunk/base/src/port1.0/fetch_common.tcl
    trunk/base/src/port1.0/portactivate.tcl
    trunk/base/src/port1.0/portfetch.tcl
    trunk/base/src/port1.0/portinstall.tcl

Added Paths:
-----------
    trunk/base/src/package1.0/portarchivefetch.tcl

Modified: trunk/base/src/package1.0/Makefile
===================================================================
--- trunk/base/src/package1.0/Makefile	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/package1.0/Makefile	2010-03-16 04:42:56 UTC (rev 64816)
@@ -1,7 +1,8 @@
 INSTALLDIR=	${DESTDIR}${datadir}/macports/Tcl/package1.0
 
 SRCS=	package.tcl portdmg.tcl portmdmg.tcl portmpkg.tcl portpkg.tcl portportpkg.tcl \
-	portrpm.tcl portsrpm.tcl portdpkg.tcl portunarchive.tcl portarchive.tcl
+	portrpm.tcl portsrpm.tcl portdpkg.tcl portunarchive.tcl portarchive.tcl \
+	portarchivefetch.tcl
 
 include ../../Mk/macports.autoconf.mk
 

Modified: trunk/base/src/package1.0/package.tcl
===================================================================
--- trunk/base/src/package1.0/package.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/package1.0/package.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -40,5 +40,6 @@
 package require portmdmg 1.0
 package require portdpkg 1.0
 package require portportpkg 1.0
+package require portarchivefetch 1.0
 package require portunarchive 1.0
 package require portarchive 1.0

Modified: trunk/base/src/package1.0/portarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portarchive.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/package1.0/portarchive.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -37,7 +37,7 @@
 set org.macports.archive [target_new org.macports.archive portarchive::archive_main]
 target_init ${org.macports.archive} portarchive::archive_init
 target_provides ${org.macports.archive} archive
-target_requires ${org.macports.archive} main unarchive fetch extract checksum patch configure build destroot
+target_requires ${org.macports.archive} main archivefetch unarchive fetch extract checksum patch configure build destroot
 target_prerun ${org.macports.archive} portarchive::archive_start
 target_postrun ${org.macports.archive} portarchive::archive_finish
 
@@ -123,7 +123,7 @@
                 }
             } else {
                 ui_debug "Skipping [string toupper ${archive.type}] archive: $errmsg"
-                set unsupported [expr $unsupported + 1]
+                incr unsupported
             }
         }
         if {!$any_missing} {

Copied: trunk/base/src/package1.0/portarchivefetch.tcl (from rev 64759, trunk/base/src/port1.0/portfetch.tcl)
===================================================================
--- trunk/base/src/package1.0/portarchivefetch.tcl	                        (rev 0)
+++ trunk/base/src/package1.0/portarchivefetch.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -0,0 +1,247 @@
+# -*- 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
+# $Id$
+#
+# Copyright (c) 2002 - 2003 Apple Inc.
+# Copyright (c) 2004-2010 The MacPorts Project
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. Neither the name of Apple Inc. nor the names of its contributors
+#    may be used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+
+package provide portarchivefetch 1.0
+package require fetch_common 1.0
+package require portutil 1.0
+package require Pextlib 1.0
+
+set org.macports.archivefetch [target_new org.macports.archivefetch portarchivefetch::archivefetch_main]
+target_init ${org.macports.archivefetch} portarchivefetch::archivefetch_init
+target_provides ${org.macports.archivefetch} archivefetch
+target_requires ${org.macports.archivefetch} main
+target_prerun ${org.macports.archivefetch} portarchivefetch::archivefetch_start
+
+namespace eval portarchivefetch {
+    variable archivefetch_urls {}
+}
+
+options archive_sites archivefetch.user archivefetch.password \
+    archivefetch.use_epsv archivefetch.ignore_sslcert \
+    archive_sites.mirror_subdir
+
+# user name & password
+default archivefetch.user ""
+default archivefetch.password ""
+# Use EPSV for FTP transfers
+default archivefetch.use_epsv no
+# Ignore SSL certificate
+default archivefetch.ignore_sslcert no
+
+# TODO: enable this when binaries are available on a macports server
+#default archive_sites macports_archives
+default archive_sites.listfile {"archive_sites.tcl"}
+default archive_sites.listpath {"port1.0/fetch"}
+
+set_ui_prefix
+
+# Checks possible archive files to assemble url lists for later fetching
+proc portarchivefetch::checkarchivefiles {urls} {
+    global all_archive_files supported_archs configure.build_arch os.arch \
+           configure.universal_archs archivefetch.fulldestpath \
+           portarchivepath name version revision portvariants archive_sites
+    upvar $urls fetch_urls
+
+    # Define archive directory, file, and path
+    if {$supported_archs == "noarch"} {
+        set archivefetch.fulldestpath [file join ${portarchivepath} [option os.platform] noarch]
+    } elseif {[variant_exists universal] && [variant_isset universal]} {
+        set archivefetch.fulldestpath [file join ${portarchivepath} [option os.platform] "universal"]
+    } elseif {${configure.build_arch} != ""} {
+        set archivefetch.fulldestpath [file join ${portarchivepath} [option os.platform] ${configure.build_arch}]
+    } else {
+        set archivefetch.fulldestpath [file join ${portarchivepath} [option os.platform] ${os.arch}]
+    }
+
+    set unsupported 0
+    set found 0
+    foreach archive.type [option portarchivetype] {
+        if {[catch {archiveTypeIsSupported ${archive.type}} errmsg] == 0} {
+            if {$supported_archs == "noarch"} {
+                set archstring noarch
+            } elseif {[variant_exists universal] && [variant_isset universal]} {
+                set archstring [join [lsort -ascii ${configure.universal_archs}] -]
+            } elseif {${configure.build_arch} != ""} {
+                set archstring ${configure.build_arch}
+            } else {
+                set archstring ${os.arch}
+            }
+            set archive.file "${name}-${version}_${revision}${portvariants}.${archstring}.${archive.type}"
+            set archive.path [file join ${archivefetch.fulldestpath} ${archive.file}]
+            if {[file exists ${archive.path}]} {
+                set found 1
+                break
+            } else {
+                lappend all_archive_files ${archive.file}
+                if {[info exists archive_sites]} {
+                    lappend fetch_urls archive_sites ${archive.file}
+                }
+            }
+        } else {
+            ui_debug "Skipping [string toupper ${archive.type}] archive: $errmsg"
+            incr unsupported
+        }
+    }
+    if {$found} {
+        ui_debug "Found [string toupper ${archive.type}] archive: ${archive.path}"
+        set all_archive_files {}
+        set fetch_urls {}
+    } elseif {[llength [option portarchivetype]] == $unsupported} {
+        return -code error "Unable to fetch archive ($name) since specified archive types not supported"
+    }
+}
+
+# returns full path to mirror list file
+proc portarchivefetch::get_full_archive_sites_path {} {
+    global archive_sites.listfile archive_sites.listpath porturl
+    return [getportresourcepath $porturl [file join ${archive_sites.listpath} ${archive_sites.listfile}]]
+}
+
+# Perform the full checksites/checkarchivefiles sequence.
+proc portarchivefetch::checkfiles {urls} {
+    upvar $urls fetch_urls
+
+    portfetch::checksites [list archive_sites [list {} {} ARCHIVE_SITE_LOCAL]] \
+                          [get_full_archive_sites_path]
+    checkarchivefiles fetch_urls
+}
+
+
+# Perform a standard fetch, assembling fetch urls from
+# the listed url variable and associated archive file
+proc portarchivefetch::fetchfiles {args} {
+    global archivefetch.fulldestpath UI_PREFIX
+    global archivefetch.user archivefetch.password archivefetch.use_epsv \
+           archivefetch.ignore_sslcert
+    global portverbose ports_binary_only
+    variable archivefetch_urls
+    variable ::portfetch::urlmap
+
+    if {![file isdirectory ${archivefetch.fulldestpath}]} {
+        if {[catch {file mkdir ${archivefetch.fulldestpath}} result]} {
+            elevateToRoot "archivefetch"
+            set elevated yes
+            if {[catch {file mkdir ${archivefetch.fulldestpath}} result]} {
+                return -code error [format [msgcat::mc "Unable to create archive path: %s"] $result]
+            }
+        }
+    }
+    chownAsRoot ${archivefetch.fulldestpath}
+    if {[info exists elevated] && $elevated == yes} {
+        dropPrivileges
+    }
+
+    set fetch_options {}
+    if {[string length ${archivefetch.user}] || [string length ${archivefetch.password}]} {
+        lappend fetch_options -u
+        lappend fetch_options "${archivefetch.user}:${archivefetch.password}"
+    }
+    if {${archivefetch.use_epsv} != "yes"} {
+        lappend fetch_options "--disable-epsv"
+    }
+    if {${archivefetch.ignore_sslcert} != "no"} {
+        lappend fetch_options "--ignore-ssl-cert"
+    }
+    if {$portverbose == "yes"} {
+        lappend fetch_options "-v"
+    }
+    set sorted no
+
+    foreach {url_var archive} $archivefetch_urls {
+        if {![file isfile ${archivefetch.fulldestpath}/${archive}]} {
+            ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $archive ${archivefetch.fulldestpath}]"
+            if {![file writable ${archivefetch.fulldestpath}]} {
+                return -code error [format [msgcat::mc "%s must be writable"] ${archivefetch.fulldestpath}]
+            }
+            if {!$sorted} {
+                portfetch::sortsites archivefetch_urls {} archive_sites
+                set sorted yes
+            }
+            if {![info exists urlmap($url_var)]} {
+                ui_error [format [msgcat::mc "No defined site for tag: %s, using archive_sites"] $url_var]
+                set urlmap($url_var) $archive_sites
+            }
+            unset -nocomplain fetched
+            foreach site $urlmap($url_var) {
+                ui_msg "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] $archive $site]"
+                set file_url [portfetch::assemble_url $site $archive]
+                set effectiveURL ""
+                if {![catch {eval curl fetch --effective-url effectiveURL $fetch_options {$file_url} ${archivefetch.fulldestpath}/${archive}.TMP} result] &&
+                    ![catch {file rename -force "${archivefetch.fulldestpath}/${archive}.TMP" "${archivefetch.fulldestpath}/${archive}"} result]} {
+                    # Successful fetch
+                    set fetched 1
+                    break
+                } else {
+                    ui_debug "[msgcat::mc "Fetching archive failed:"]: $result"
+                    file delete -force "${archivefetch.fulldestpath}/${archive}.TMP"
+                }
+            }
+            if {[info exists fetched]} {
+                return 0
+            }
+        } else {
+            return 0
+        }
+    }
+    if {[info exists ports_binary_only] && $ports_binary_only == "yes"} {
+        return -code error "archivefetch failed for [option name] @[option version]_[option revision][option portvariants]"
+    } else {
+        return 0
+    }
+}
+
+# Initialize archivefetch target and call checkfiles.
+proc portarchivefetch::archivefetch_init {args} {
+    variable archivefetch_urls
+
+    if {[option portarchivemode] != "yes"} {
+        return -code error "Archive mode is not enabled!"
+    }
+
+    portarchivefetch::checkfiles archivefetch_urls
+}
+
+proc portarchivefetch::archivefetch_start {args} {
+    global UI_PREFIX name
+
+    ui_msg "$UI_PREFIX [format [msgcat::mc "Fetching archive for %s"] $name]"
+}
+
+# Main archive fetch routine
+# just calls the standard fetchfiles procedure
+proc portarchivefetch::archivefetch_main {args} {
+    global all_archive_files
+    if {[info exists all_archive_files] && [llength $all_archive_files] > 0} {
+        # Fetch the files
+        return [portarchivefetch::fetchfiles]
+    }
+}

Modified: trunk/base/src/package1.0/portpkg.tcl
===================================================================
--- trunk/base/src/package1.0/portpkg.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/package1.0/portpkg.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -37,7 +37,7 @@
 target_runtype ${org.macports.pkg} always
 target_provides ${org.macports.pkg} pkg
 if {[option portarchivemode] == "yes"} {
-    target_requires ${org.macports.pkg} unarchive destroot
+    target_requires ${org.macports.pkg} archivefetch unarchive destroot
 } else {
     target_requires ${org.macports.pkg} destroot
 }

Modified: trunk/base/src/package1.0/portunarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portunarchive.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/package1.0/portunarchive.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -38,7 +38,7 @@
 target_runtype ${org.macports.unarchive} always
 target_init ${org.macports.unarchive} portunarchive::unarchive_init
 target_provides ${org.macports.unarchive} unarchive
-target_requires ${org.macports.unarchive} main
+target_requires ${org.macports.unarchive} main archivefetch
 target_prerun ${org.macports.unarchive} portunarchive::unarchive_start
 target_postrun ${org.macports.unarchive} portunarchive::unarchive_finish
 
@@ -124,7 +124,7 @@
                 }
             } else {
                 ui_debug "Skipping [string toupper ${unarchive.type}] archive: $errmsg"
-                set unsupported [expr $unsupported + 1]
+                incr unsupported
             }
         }
         if {$found == 1} {

Modified: trunk/base/src/port/port-help.tcl
===================================================================
--- trunk/base/src/port/port-help.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/port/port-help.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -15,6 +15,10 @@
 Archive the given ports
 }
 
+set porthelp(archivefetch) {
+Fetch archive for the given ports
+}
+
 set porthelp(build) {
 Build the given ports
 }

Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/port/port.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -3233,6 +3233,7 @@
     distfiles   [list action_target         [ACTION_ARGS_PORTS]] \
     \
     archive     [list action_target         [ACTION_ARGS_PORTS]] \
+    archivefetch [list action_target         [ACTION_ARGS_PORTS]] \
     unarchive   [list action_target         [ACTION_ARGS_PORTS]] \
     dmg         [list action_target         [ACTION_ARGS_PORTS]] \
     mdmg        [list action_target         [ACTION_ARGS_PORTS]] \

Modified: trunk/base/src/port1.0/fetch_common.tcl
===================================================================
--- trunk/base/src/port1.0/fetch_common.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/port1.0/fetch_common.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -123,15 +123,15 @@
     global env
     variable urlmap
 
-    foreach {list extras} $sitelists {
-        upvar #0 $list uplist
-        if {![info exists uplist]} {
+    foreach {listname extras} $sitelists {
+        upvar #0 $listname $listname
+        if {![info exists $listname]} {
             continue
         }
-        global ${list}.mirror_subdir
+        global ${listname}.mirror_subdir
         # add the specified global, fallback and user-defined mirrors
         set sglobal [lindex $extras 0]; set sfallback [lindex $extras 1]; set senv [lindex $extras 2]
-        set full_list $uplist
+        set full_list [set $listname]
         append full_list " $sglobal $sfallback"
         if {[info exists env($senv)]} {
             set full_list [concat $env($senv) $full_list]
@@ -149,8 +149,8 @@
                 set mirrors "[lindex $splitlist 0]"
                 set subdir "[lindex $splitlist 1]"
                 set tag "[lindex $splitlist 2]"
-                if {[info exists $list.mirror_subdir]} {
-                    append subdir "[set ${list}.mirror_subdir]"
+                if {[info exists ${listname}.mirror_subdir]} {
+                    append subdir "[set ${listname}.mirror_subdir]"
                 }
                 set site_list [concat $site_list [mirror_sites $mirrors $tag $subdir $mirrorfile]]
             }
@@ -176,7 +176,7 @@
         if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag]} {
                 lappend urlmap($tag) $site
             } else {
-                lappend urlmap($list) $site
+                lappend urlmap($listname) $site
             }
         }
     }

Modified: trunk/base/src/port1.0/portactivate.tcl
===================================================================
--- trunk/base/src/port1.0/portactivate.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/port1.0/portactivate.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -41,7 +41,7 @@
 target_state ${org.macports.activate} no
 target_provides ${org.macports.activate} activate
 if {[option portarchivemode] == "yes"} {
-    target_requires ${org.macports.activate} main unarchive fetch extract checksum patch configure build destroot archive install
+    target_requires ${org.macports.activate} main archivefetch unarchive fetch extract checksum patch configure build destroot archive install
 } else {
     target_requires ${org.macports.activate} main fetch extract checksum patch configure build destroot install
 }

Modified: trunk/base/src/port1.0/portfetch.tcl
===================================================================
--- trunk/base/src/port1.0/portfetch.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/port1.0/portfetch.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -261,7 +261,7 @@
 # Perform the full checksites/checkpatchfiles/checkdistfiles sequence.
 # This method is used by distcheck target.
 proc portfetch::checkfiles {urls} {
-    global patch_sites master_sites global_mirror_site fallback_mirror_site env
+    global global_mirror_site fallback_mirror_site
     upvar $urls fetch_urls
 
     checksites [list patch_sites [list $global_mirror_site $fallback_mirror_site PATCH_SITE_LOCAL] \
@@ -396,8 +396,7 @@
 proc portfetch::fetchfiles {args} {
     global distpath all_dist_files UI_PREFIX
     global fetch.user fetch.password fetch.use_epsv fetch.ignore_sslcert fetch.remote_time
-    global distfile site fallback_mirror_site
-    global portverbose
+    global fallback_mirror_site portverbose
     variable fetch_urls
     variable urlmap
 

Modified: trunk/base/src/port1.0/portinstall.tcl
===================================================================
--- trunk/base/src/port1.0/portinstall.tcl	2010-03-16 04:21:29 UTC (rev 64815)
+++ trunk/base/src/port1.0/portinstall.tcl	2010-03-16 04:42:56 UTC (rev 64816)
@@ -39,7 +39,7 @@
 target_provides ${org.macports.install} install
 target_runtype ${org.macports.install} always
 if {[option portarchivemode] == "yes"} {
-    target_requires ${org.macports.install} main unarchive fetch extract checksum patch configure build destroot archive
+    target_requires ${org.macports.install} main archivefetch unarchive fetch extract checksum patch configure build destroot archive
 } else {
     target_requires ${org.macports.install} main fetch extract checksum patch configure build destroot
 }
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100315/018bcd98/attachment-0001.html>


More information about the macports-changes mailing list