[90958] trunk/base/src
jmr at macports.org
jmr at macports.org
Mon Mar 19 11:14:31 PDT 2012
Revision: 90958
https://trac.macports.org/changeset/90958
Author: jmr at macports.org
Date: 2012-03-19 11:14:31 -0700 (Mon, 19 Mar 2012)
Log Message:
-----------
only move archives into their final installed location in the install phase, not in archivefetch; and factor out some more archive related helper procs
Modified Paths:
--------------
trunk/base/src/package1.0/portarchivefetch.tcl
trunk/base/src/package1.0/portunarchive.tcl
trunk/base/src/port1.0/portinstall.tcl
trunk/base/src/port1.0/portutil.tcl
Modified: trunk/base/src/package1.0/portarchivefetch.tcl
===================================================================
--- trunk/base/src/package1.0/portarchivefetch.tcl 2012-03-19 18:10:25 UTC (rev 90957)
+++ trunk/base/src/package1.0/portarchivefetch.tcl 2012-03-19 18:14:31 UTC (rev 90958)
@@ -2,7 +2,7 @@
# $Id$
#
# Copyright (c) 2002 - 2003 Apple Inc.
-# Copyright (c) 2004 - 2011 The MacPorts Project
+# Copyright (c) 2004 - 2012 The MacPorts Project
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -91,14 +91,14 @@
version revision portvariants archive_sites
upvar $urls fetch_urls
- # Define archive directory path
- set archive.path [get_portimage_path]
- set archivefetch.fulldestpath [file dirname ${archive.path}]
-
# throws an error if unsupported
archiveTypeIsSupported $portarchivetype
- set archive.file [file tail ${archive.path}]
+ # Define archive directory path
+ set archivefetch.fulldestpath [file join [option portdbpath] incoming/verified]
+ set archive.file [get_portimage_name]
+ set archive.path [file join ${archivefetch.fulldestpath} ${archive.file}]
+
lappend all_archive_files ${archive.file}
if {[info exists archive_sites]} {
lappend fetch_urls archive_sites ${archive.file}
@@ -141,16 +141,6 @@
}
}
set incoming_path [file join [option portdbpath] incoming]
- if {![file isdirectory $incoming_path]} {
- if {[catch {file mkdir $incoming_path} result]} {
- elevateToRoot "archivefetch"
- set elevated yes
- if {[catch {file mkdir $incoming_path} result]} {
- return -code error [format [msgcat::mc "Unable to create archive fetch path: %s"] $result]
- }
- }
- }
- chownAsRoot ${archivefetch.fulldestpath}
chownAsRoot $incoming_path
if {[info exists elevated] && $elevated == yes} {
dropPrivileges
@@ -172,8 +162,10 @@
}
set sorted no
+ set existing_archive [find_portarchive_path]
+
foreach {url_var archive} $archivefetch_urls {
- if {![file isfile ${archivefetch.fulldestpath}/${archive}]} {
+ if {![file isfile ${archivefetch.fulldestpath}/${archive}] && $existing_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}]
@@ -261,7 +253,7 @@
proc portarchivefetch::archivefetch_init {args} {
global porturl portarchivetype
# installing straight from a binary archive
- if {[file rootname [file tail $porturl]] == [file rootname [file tail [get_portimage_path]]] && [file extension $porturl] != ""} {
+ if {[file rootname [file tail $porturl]] == [file rootname [get_portimage_name]] && [file extension $porturl] != ""} {
set portarchivetype [string range [file extension $porturl] 1 end]
}
return 0
Modified: trunk/base/src/package1.0/portunarchive.tcl
===================================================================
--- trunk/base/src/package1.0/portunarchive.tcl 2012-03-19 18:10:25 UTC (rev 90957)
+++ trunk/base/src/package1.0/portunarchive.tcl 2012-03-19 18:14:31 UTC (rev 90958)
@@ -2,7 +2,7 @@
# portunarchive.tcl
# $Id$
#
-# Copyright (c) 2005, 2007-2011 The MacPorts Project
+# Copyright (c) 2005, 2007-2012 The MacPorts Project
# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
# Copyright (c) 2002 - 2003 Apple Inc.
# All rights reserved.
@@ -82,19 +82,10 @@
ui_debug "Skipping unarchive ($subport) since force is set"
set skipped 1
} else {
- set found 0
- set rootname [file rootname [get_portimage_path]]
- foreach unarchive.type [supportedArchiveTypes] {
- set unarchive.path "${rootname}.${unarchive.type}"
- set unarchive.file [file tail ${unarchive.path}]
- if {[file isfile ${unarchive.path}]} {
- set found 1
- break
- } else {
- ui_debug "No [string toupper ${unarchive.type}] archive: ${unarchive.path}"
- }
- }
- if {$found == 1} {
+ set unarchive.path [find_portarchive_path]
+ set unarchive.file [file tail ${unarchive.path}]
+ set unarchive.type [string range [file extension ${unarchive.file}] 1 end]
+ if {${unarchive.path} != ""} {
ui_debug "Found [string toupper ${unarchive.type}] archive: ${unarchive.path}"
} else {
if {[info exists ports_binary_only] && $ports_binary_only == "yes"} {
Modified: trunk/base/src/port1.0/portinstall.tcl
===================================================================
--- trunk/base/src/port1.0/portinstall.tcl 2012-03-19 18:10:25 UTC (rev 90957)
+++ trunk/base/src/port1.0/portinstall.tcl 2012-03-19 18:14:31 UTC (rev 90958)
@@ -4,7 +4,7 @@
#
# Copyright (c) 2002 - 2004 Apple Inc.
# Copyright (c) 2004 Robert Shaw <rshaw at opendarwin.org>
-# Copyright (c) 2005, 2007 - 2011 The MacPorts Project
+# Copyright (c) 2005, 2007 - 2012 The MacPorts Project
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -491,19 +491,22 @@
set oldpwd $portpath
}
- # throws an error if an unsupported value has been configured
- archiveTypeIsSupported $portarchivetype
-
set location [get_portimage_path]
- if {![file isfile $location]} {
+ set archive_path [find_portarchive_path]
+ if {$archive_path != ""} {
+ set install_dir [file dirname $location]
+ file mkdir $install_dir
+ file rename -force $archive_path $install_dir
+ set location [file join $install_dir [file tail $archive_path]]
+ set current_archive_type [string range [file extension $location] 1 end]
+ set installPlist [extract_contents $location $current_archive_type]
+ } else {
+ # throws an error if an unsupported value has been configured
+ archiveTypeIsSupported $portarchivetype
# create archive from the destroot
create_archive $location $portarchivetype
}
- if {![info exists installPlist]} {
- set installPlist [extract_contents $location $portarchivetype]
- }
-
# can't do this inside the write transaction due to deadlock issues with _get_dep_port
set dep_portnames [list]
foreach deplist {depends_lib depends_run} {
Modified: trunk/base/src/port1.0/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/portutil.tcl 2012-03-19 18:10:25 UTC (rev 90957)
+++ trunk/base/src/port1.0/portutil.tcl 2012-03-19 18:14:31 UTC (rev 90958)
@@ -2320,10 +2320,16 @@
}
}
-# return path where the image/archive for this port will be stored
+# return filename of the archive for this port
+proc get_portimage_name {} {
+ global portdbpath subport version revision portvariants os.platform os.major portarchivetype
+ return "${subport}-${version}_${revision}${portvariants}.${os.platform}_${os.major}.[join [get_canonical_archs] -].${portarchivetype}"
+}
+
+# return path where a newly created image/archive for this port will be stored
proc get_portimage_path {} {
- global registry.path subport version revision portvariants os.platform os.major portarchivetype
- return [file join ${registry.path} software ${subport} "${subport}-${version}_${revision}${portvariants}.${os.platform}_${os.major}.[join [get_canonical_archs] -].${portarchivetype}"]
+ global portdbpath subport
+ return [file join ${portdbpath} software ${subport} [get_portimage_name]]
}
# return list of archive types that we can extract
@@ -2340,6 +2346,28 @@
return $supported_archive_types
}
+# return path to a downloaded or installed archive for this port
+proc find_portarchive_path {} {
+ global portdbpath subport version revision portvariants
+ set installed 0
+ if {[registry_exists $subport $version $revision $portvariants]} {
+ set installed 1
+ }
+ set archiverootname [file rootname [get_portimage_name]]
+ foreach unarchive.type [supportedArchiveTypes] {
+ set fullarchivename "${archiverootname}.${unarchive.type}"
+ if {$installed} {
+ set fullarchivepath [file join $portdbpath software $subport $fullarchivename]
+ } else {
+ set fullarchivepath [file join $portdbpath incoming/verified $fullarchivename]
+ }
+ if {[file isfile $fullarchivepath]} {
+ return $fullarchivepath
+ }
+ }
+ return ""
+}
+
# check if archive type is supported by current system
# returns an error code if it is not
proc archiveTypeIsSupported {type} {
@@ -2857,28 +2885,22 @@
# check if we can unarchive this port
proc _archive_available {} {
- global subport version revision portvariants ports_source_only workpath \
- registry.path os.platform os.major porturl
+ global ports_source_only porturl
if {[tbool ports_source_only]} {
return 0
}
- set found 0
- foreach unarchive.type [supportedArchiveTypes] {
- set fullarchivepath [file join ${registry.path} software ${subport} "${subport}-${version}_${revision}${portvariants}.${os.platform}_${os.major}.[join [get_canonical_archs] -].${unarchive.type}"]
- if {[file isfile $fullarchivepath]} {
- set found 1
- break
- }
+ if {[find_portarchive_path] != ""} {
+ return 1
}
- if {!$found && [file rootname [file tail $porturl]] == [file rootname [file tail [get_portimage_path]]] && [file extension $porturl] != ""} {
- set found 1
+ if {[file rootname [file tail $porturl]] == [file rootname [get_portimage_name]] && [file extension $porturl] != ""} {
+ return 1
}
- # TODO: maybe check if there's an archive available on the server - this
+ # TODO: check if there's an archive available on the server - this
# is much less useful otherwise now that archive == installed image
- return $found
+ return 0
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20120319/36837239/attachment.html>
More information about the macports-changes
mailing list