[147031] branches/vcs-fetch/base
raimue at macports.org
raimue at macports.org
Wed Mar 23 16:51:56 PDT 2016
Revision: 147031
https://trac.macports.org/changeset/147031
Author: raimue at macports.org
Date: 2016-03-23 16:51:56 -0700 (Wed, 23 Mar 2016)
Log Message:
-----------
Merge from trunk
Modified Paths:
--------------
branches/vcs-fetch/base/doc/port-diagnose.1
branches/vcs-fetch/base/doc/port-reclaim.1
branches/vcs-fetch/base/doc/port.1
branches/vcs-fetch/base/doc/portgroup.7
branches/vcs-fetch/base/src/macports1.0/Makefile.in
branches/vcs-fetch/base/src/macports1.0/macports.tcl
branches/vcs-fetch/base/src/macports1.0/macports_util.tcl
branches/vcs-fetch/base/src/macports1.0/reclaim.tcl
branches/vcs-fetch/base/src/macports1.0/tests/library.tcl
branches/vcs-fetch/base/src/macports1.0/tests/macports.test
branches/vcs-fetch/base/src/macports1.0/tests/reclaim.test
branches/vcs-fetch/base/src/port/port.tcl
branches/vcs-fetch/base/src/port/portindex.tcl
branches/vcs-fetch/base/src/port1.0/portbuild.tcl
branches/vcs-fetch/base/src/port1.0/portclean.tcl
branches/vcs-fetch/base/src/port1.0/portdistcheck.tcl
branches/vcs-fetch/base/src/port1.0/portfetch.tcl
branches/vcs-fetch/base/src/port1.0/portutil.tcl
branches/vcs-fetch/base/src/port1.0/tests/portactivate.test
branches/vcs-fetch/base/src/registry2.0/portimage.tcl
branches/vcs-fetch/base/src/registry2.0/portuninstall.tcl
Added Paths:
-----------
branches/vcs-fetch/base/src/macports1.0/selfupdate.tcl
branches/vcs-fetch/base/src/port1.0/tests/portbuild.test
Property Changed:
----------------
branches/vcs-fetch/base/
branches/vcs-fetch/base/doc/port-diagnose.1.txt
branches/vcs-fetch/base/doc/port-reclaim.1.txt
Property changes on: branches/vcs-fetch/base
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base:37343-46937
/branches/gsoc09-logging/base:51231-60371
/branches/gsoc11-rev-upgrade/base:78828-88375
/branches/gsoc11-statistics/base:79520,79666
/branches/gsoc13-tests:106692-111324
/branches/gsoc14-cleanup:123738-124046
/branches/gsoc14-interactive/base:119516-124240
/branches/gsoc15-dependency/base:138631
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
+ /branches/gsoc08-privileges/base:37343-46937
/branches/gsoc09-logging/base:51231-60371
/branches/gsoc11-rev-upgrade/base:78828-88375
/branches/gsoc11-statistics/base:79520,79666
/branches/gsoc13-tests:106692-111324
/branches/gsoc14-cleanup:123738-124046
/branches/gsoc14-interactive/base:119516-124240
/branches/gsoc15-dependency/base:138631
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:146631-147030
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
Modified: branches/vcs-fetch/base/doc/port-diagnose.1
===================================================================
--- branches/vcs-fetch/base/doc/port-diagnose.1 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/doc/port-diagnose.1 2016-03-23 23:51:56 UTC (rev 147031)
@@ -1,5 +1,5 @@
'\" t
-.TH "PORT\-DIAGNOSE" "1" "10/18/2015" "MacPorts 2\&.3\&.99" "MacPorts Manual"
+.TH "PORT\-DIAGNOSE" "1" "2016\-03\-15" "MacPorts 2\&.3\&.99" "MacPorts Manual"
.\" -----------------------------------------------------------------
.\" * Define some portability stuff
.\" -----------------------------------------------------------------
Property changes on: branches/vcs-fetch/base/doc/port-diagnose.1.txt
___________________________________________________________________
Added: svn:keywords
+ Id
Added: svn:eol-style
+ native
Modified: branches/vcs-fetch/base/doc/port-reclaim.1
===================================================================
--- branches/vcs-fetch/base/doc/port-reclaim.1 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/doc/port-reclaim.1 2016-03-23 23:51:56 UTC (rev 147031)
@@ -1,5 +1,5 @@
'\" t
-.TH "PORT\-RECLAIM" "1" "10/18/2015" "MacPorts 2\&.3\&.99" "MacPorts Manual"
+.TH "PORT\-RECLAIM" "1" "2016\-03\-15" "MacPorts 2\&.3\&.99" "MacPorts Manual"
.\" -----------------------------------------------------------------
.\" * Define some portability stuff
.\" -----------------------------------------------------------------
Property changes on: branches/vcs-fetch/base/doc/port-reclaim.1.txt
___________________________________________________________________
Added: svn:keywords
+ Id
Added: svn:eol-style
+ native
Modified: branches/vcs-fetch/base/doc/port.1
===================================================================
--- branches/vcs-fetch/base/doc/port.1 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/doc/port.1 2016-03-23 23:51:56 UTC (rev 147031)
@@ -947,7 +947,8 @@
.RS 4
Clean the files used for building
\fIportname\fR\&. To just remove the work files, use the
-\fB\-\-work\fR\fIactionflag\fR\&. This is the default when no flag is given\&. To remove the distribution files (fetched tarballs, patches, etc), specify
+\fB\-\-work\fR
+\fIactionflag\fR\&. This is the default when no flag is given\&. To remove the distribution files (fetched tarballs, patches, etc), specify
\fB\-\-dist\fR\&. To remove any archive(s) of a port than remain in the temporary download directory, pass
\fB\-\-archive\fR\&. (This does not remove archives from the installed location\&.) To remove log files for a port, pass
\fB\-\-logs\fR\&. To remove the work files, distribution files, temporary archives and logs pass
Modified: branches/vcs-fetch/base/doc/portgroup.7
===================================================================
--- branches/vcs-fetch/base/doc/portgroup.7 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/doc/portgroup.7 2016-03-23 23:51:56 UTC (rev 147031)
@@ -443,7 +443,8 @@
.PP
homepage
.RS 4
-\fBDefault:\fR\m[blue]\fBhttp://www\&.gnustep\&.org/\fR\m[]
+\fBDefault:\fR
+\m[blue]\fBhttp://www\&.gnustep\&.org/\fR\m[]
.RE
.PP
master_sites
Modified: branches/vcs-fetch/base/src/macports1.0/Makefile.in
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/Makefile.in 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/Makefile.in 2016-03-23 23:51:56 UTC (rev 147031)
@@ -4,7 +4,7 @@
include ../../Mk/macports.autoconf.mk
SRCS= macports.tcl macports_dlist.tcl macports_util.tcl \
- macports_autoconf.tcl diagnose.tcl reclaim.tcl
+ macports_autoconf.tcl diagnose.tcl reclaim.tcl selfupdate.tcl
OBJS= macports.o get_systemconfiguration_proxies.o sysctl.o
SHLIB_NAME= MacPorts${SHLIB_SUFFIX}
Modified: branches/vcs-fetch/base/src/macports1.0/macports.tcl
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/macports.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/macports.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -38,6 +38,7 @@
package require macports_util 1.0
package require diagnose 1.0
package require reclaim 1.0
+package require selfupdate 1.0
package require Tclx
namespace eval macports {
@@ -154,8 +155,8 @@
set ::debuglogname $logname
- # Truncate the file if already exists
- set ::debuglog [open $::debuglogname w]
+ # Append to the file if it already exists
+ set ::debuglog [open $::debuglogname a]
puts $::debuglog version:1
}
proc macports::push_log {mport} {
@@ -354,10 +355,11 @@
if {$autoconf_hint ne "" && [file executable $autoconf_hint]} {
return $autoconf_hint
} else {
- if {[catch {set cmd_path [macports::binaryInPath $prog]} result] == 0} {
+ try -pass_signal {
+ set cmd_path [macports::binaryInPath $prog]
return $cmd_path
- } else {
- return -code error "$result or at its MacPorts configuration time location, did you move it?"
+ } catch {{*} eCode eMessage} {
+ error "$eMessage or at its MacPorts configuration time location, did you move it?"
}
}
}
@@ -387,11 +389,13 @@
trace remove variable macports::xcodeversion read macports::setxcodeinfo
trace remove variable macports::xcodebuildcmd read macports::setxcodeinfo
- if {![catch {findBinary xcodebuild $macports::autoconf::xcodebuild_path} xcodebuild]} {
+ try -pass_signal {
+ set xcodebuild [findBinary xcodebuild $macports::autoconf::xcodebuild_path]
if {![info exists xcodeversion]} {
# Determine xcode version
set macports::xcodeversion 2.0orlower
- if {[catch {set xcodebuildversion [exec -- $xcodebuild -version 2> /dev/null]}] == 0} {
+ try -pass_signal {
+ set xcodebuildversion [exec -- $xcodebuild -version 2> /dev/null]
if {[regexp {Xcode ([0-9.]+)} $xcodebuildversion - xcode_v] == 1} {
set macports::xcodeversion $xcode_v
} elseif {[regexp {DevToolsCore-(.*);} $xcodebuildversion - devtoolscore_v] == 1} {
@@ -421,7 +425,7 @@
set macports::xcodeversion 2.1
}
}
- } else {
+ } catch {*} {
ui_warn "xcodebuild exists but failed to execute"
set macports::xcodeversion none
}
@@ -429,7 +433,7 @@
if {![info exists xcodebuildcmd]} {
set macports::xcodebuildcmd $xcodebuild
}
- } else {
+ } catch {*} {
if {![info exists xcodeversion]} {
set macports::xcodeversion none
}
@@ -446,24 +450,29 @@
trace remove variable macports::developer_dir read macports::set_developer_dir
# Look for xcodeselect, and make sure it has a valid value
- if {![catch {findBinary xcode-select $macports::autoconf::xcode_select_path} xcodeselect]} {
+ try -pass_signal {
+ set xcodeselect [findBinary xcode-select $macports::autoconf::xcode_select_path]
# We have xcode-select: ask it where xcode is and check if it's valid.
# If no xcode is selected, xcode-select will fail, so catch that
- if {![catch {exec $xcodeselect -print-path 2> /dev/null} devdir] &&
- [_is_valid_developer_dir $devdir]} {
- set macports::developer_dir $devdir
- return
- }
+ try -pass_signal {
+ set devdir [exec $xcodeselect -print-path 2> /dev/null]
+ if {[_is_valid_developer_dir $devdir]} {
+ set macports::developer_dir $devdir
+ return
+ }
+ } catch {*} {}
# The directory from xcode-select isn't correct.
# Ask mdfind where Xcode is and make some suggestions for the user,
# searching by bundle identifier for various Xcode versions (3.x and 4.x)
set installed_xcodes {}
- if {![catch {findBinary mdfind $macports::autoconf::mdfind_path} mdfind]} {
+
+ try -pass_signal {
+ set mdfind [findBinary mdfind $macports::autoconf::mdfind_path]
set installed_xcodes [exec $mdfind "kMDItemCFBundleIdentifier == 'com.apple.Xcode' || kMDItemCFBundleIdentifier == 'com.apple.dt.Xcode'"]
- }
+ } catch {*} {}
# In case mdfind metadata wasn't complete, also look in two well-known locations for Xcode.app
foreach app {/Applications/Xcode.app /Developer/Applications/Xcode.app} {
@@ -477,7 +486,13 @@
# Present instructions to the user
ui_error
- if {[llength $installed_xcodes] > 0 && ![catch {findBinary mdls $macports::autoconf::mdls_path} mdls]} {
+ try -pass_signal {
+ if {[llength $installed_xcodes] == 0} {
+ error "No Xcode installation was found."
+ }
+
+ set mdls [findBinary mdls $macports::autoconf::mdls_path]
+
# One, or more than one, Xcode installations found
ui_error "No valid Xcode installation is properly selected."
ui_error "Please use xcode-select to select an Xcode installation:"
@@ -499,12 +514,12 @@
ui_error " # malformed Xcode at ${xcode}, version $vers"
}
}
- } else {
+ } catch {*} {
ui_error "No Xcode installation was found."
ui_error "Please install Xcode and/or run xcode-select to specify its location."
}
ui_error
- }
+ } catch {*} {}
# Try the default
if {$os_major >= 11 && [vercmp $xcodeversion 4.3] >= 0} {
@@ -627,9 +642,10 @@
set os_endian [string range $tcl_platform(byteOrder) 0 end-6]
set macosx_version {}
if {$os_platform eq "darwin" && [file executable /usr/bin/sw_vers]} {
- if {![catch {exec /usr/bin/sw_vers -productVersion | cut -f1,2 -d.} result]} {
- set macosx_version $result
- } else {
+
+ try -pass_signal {
+ set macosx_version [exec /usr/bin/sw_vers -productVersion | cut -f1,2 -d.]
+ } catch {*} {
ui_debug "sw_vers exists but running it failed: $result"
}
}
@@ -876,7 +892,11 @@
# Set noninteractive mode if specified in config
if {[info exists ui_interactive] && !$ui_interactive} {
set macports::ui_options(ports_noninteractive) yes
- unset -nocomplain macports::ui_options(questions_yesno) macports::ui_options(questions_singlechoice) macports::ui_options(questions_multichoice)
+ unset -nocomplain macports::ui_options(questions_yesno) \
+ macports::ui_options(questions_singlechoice) \
+ macports::ui_options(questions_multichoice) \
+ macports::ui_options(questions_alternative)
+
}
# Archive type, what type of binary archive to use (CPIO, gzipped
@@ -1053,8 +1073,10 @@
# might slow builds down considerably. You can avoid this by touching
# $portdbpath/.nohide.
if {$os_platform eq "darwin" && [vercmp [info tclversion] 8.5] >= 0 && ![file exists [file join $portdbpath .nohide]] && [file writable $portdbpath] && [file attributes $portdbpath -hidden] == 0} {
- if {[catch {file attributes $portdbpath -hidden yes} result]} {
- ui_debug "error setting hidden flag for $portdbpath: $result"
+ try -pass_signal {
+ file attributes $portdbpath -hidden yes
+ } catch {{*} eCode eMessage} {
+ ui_debug "error setting hidden flag for $portdbpath: $eMessage"
}
}
@@ -1159,11 +1181,17 @@
set env(CCACHE_DIR) $macports::ccache_dir
# load cached ping times
- if {[catch {
+ try -pass_signal {
+ set pingfile -1
set pingfile [open ${macports::portdbpath}/pingtimes r]
array set macports::ping_cache [gets $pingfile]
- close $pingfile
- }]} {array set macports::ping_cache {}}
+ } catch {*} {
+ array set macports::ping_cache {}
+ } finally {
+ if {$pingfile != -1} {
+ close $pingfile
+ }
+ }
# set up arrays of blacklisted and preferred hosts
if {[info exists macports::host_blacklist]} {
foreach host $macports::host_blacklist {
@@ -1199,6 +1227,7 @@
# convert any flat receipts if we just created a new db
if {$db_exists == 0 && [file exists ${registry.path}/receipts] && [file writable $db_path]} {
ui_warn "Converting your registry to sqlite format, this might take a while..."
+ # XXX: catch, leave unfixed, code should go away.
if {[catch {registry::convert_to_sqlite}]} {
ui_debug $::errorInfo
file delete -force $db_path
@@ -1226,13 +1255,13 @@
close $pingfile
}
}
- # close it down so the cleanup stuff is called, e.g. vacuuming the db
- registry::close
-
- # Check the last time 'reclaim' was run
+ # Check the last time 'reclaim' was run and run it
if {![macports::ui_isset ports_quiet]} {
reclaim::check_last_run
}
+
+ # close it down so the cleanup stuff is called, e.g. vacuuming the db
+ registry::close
}
# link plist for xcode 4.3's benefit
@@ -1243,17 +1272,22 @@
file delete -force "${target_dir}/com.apple.dt.Xcode.plist"
if {[file isfile $user_plist]} {
if {![file isdirectory $target_dir]} {
- if {[catch {file mkdir $target_dir} result]} {
- ui_warn "Failed to create Library/Preferences in ${target_homedir}: $result"
+ try -pass_signal {
+ file mkdir $target_dir
+ } catch {{*} eCode eMessage} {
+ ui_warn "Failed to create Library/Preferences in ${target_homedir}: $eMessage"
return
}
}
- if {[file writable $target_dir] && [catch {
+ try -pass_signal {
+ if {![file writable $target_dir]} {
+ error "${target_dir} is not writable"
+ }
ui_debug "Copying $user_plist to $target_dir"
file copy -force $user_plist $target_dir
file attributes ${target_dir}/com.apple.dt.Xcode.plist -owner $macportsuser -permissions 0644
- } result]} {
- ui_warn "Failed to copy com.apple.dt.Xcode.plist to ${target_dir}: $result"
+ } catch {{*} eCode eMessage} {
+ ui_warn "Failed to copy com.apple.dt.Xcode.plist to ${target_dir}: $eMessage"
}
}
}
@@ -2435,7 +2469,9 @@
switch -regexp -- [macports::getprotocol $source] {
{^file$} {
set portdir [macports::getportdir $source]
- if {[catch {macports::GetVCSUpdateCmd $portdir} repoInfo]} {
+ try -pass_signal {
+ set repoInfo [macports::GetVCSUpdateCmd $portdir]
+ } catch {*} {
ui_debug $::errorInfo
ui_info "Could not access contents of $portdir"
incr numfailed
@@ -2443,7 +2479,9 @@
}
if {[llength $repoInfo]} {
lassign $repoInfo vcs cmd
- if {[catch {macports::UpdateVCS $cmd $portdir}]} {
+ try -pass_signal {
+ macports::UpdateVCS $cmd $portdir
+ } catch {*} {
ui_debug $::errorInfo
ui_info "Syncing local $vcs ports tree failed"
incr numfailed
@@ -2473,8 +2511,9 @@
}
# Do rsync fetch
set rsync_commandline "$macports::autoconf::rsync_path $rsync_options $exclude_option $source $destdir"
- ui_debug $rsync_commandline
- if {[catch {system $rsync_commandline}]} {
+ try -pass_signal {
+ system $rsync_commandline
+ } catch {*} {
ui_error "Synchronization of the local ports tree failed doing rsync"
incr numfailed
continue
@@ -2484,8 +2523,9 @@
# verify signature for tarball
global macports::archivefetch_pubkeys
set rsync_commandline "$macports::autoconf::rsync_path $rsync_options $exclude_option ${source}.rmd160 $destdir"
- ui_debug $rsync_commandline
- if {[catch {system $rsync_commandline}]} {
+ try -pass_signal {
+ system $rsync_commandline
+ } catch {*} {
ui_error "Synchronization of the ports tree signature failed doing rsync"
incr numfailed
continue
@@ -2495,13 +2535,14 @@
set openssl [macports::findBinary openssl $macports::autoconf::openssl_path]
set verified 0
foreach pubkey $macports::archivefetch_pubkeys {
- if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature $tarball} result]} {
+ try -pass_signal {
+ exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature $tarball
set verified 1
ui_debug "successful verification with key $pubkey"
break
- } else {
+ } catch {{*} eCode eMessage} {
ui_debug "failed verification with key $pubkey"
- ui_debug "openssl output: $result"
+ ui_debug "openssl output: $eMessage"
}
}
if {!$verified} {
@@ -2514,9 +2555,10 @@
set tar [macports::findBinary tar $macports::autoconf::tar_path]
file mkdir ${destdir}/tmp
set tar_cmd "$tar -C ${destdir}/tmp -xf $tarball"
- ui_debug $tar_cmd
- if {[catch {system $tar_cmd}]} {
- ui_error "Failed to extract ports tree from tarball!"
+ try -pass_signal {
+ system $tar_cmd
+ } catch {{*} eCode eMessage} {
+ ui_error "Failed to extract ports tree from tarball: $eMessage"
incr numfailed
continue
}
@@ -2545,10 +2587,9 @@
}
set remote_indexfile "${index_source}PortIndex_${macports::os_platform}_${macports::os_major}_${macports::os_arch}/PortIndex"
set rsync_commandline "$macports::autoconf::rsync_path $rsync_options $remote_indexfile $destdir"
- ui_debug $rsync_commandline
- if {[catch {system $rsync_commandline}]} {
- ui_debug "Synchronization of the PortIndex failed doing rsync"
- } else {
+ try -pass_signal {
+ system $rsync_commandline
+
set ok 1
set needs_portindex false
if {$is_tarball} {
@@ -2556,31 +2597,34 @@
set needs_portindex true
# verify signature for PortIndex
set rsync_commandline "$macports::autoconf::rsync_path $rsync_options ${remote_indexfile}.rmd160 $destdir"
- ui_debug $rsync_commandline
- if {![catch {system $rsync_commandline}]} {
- foreach pubkey $macports::archivefetch_pubkeys {
- if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature ${destdir}/PortIndex.rmd160 ${destdir}/PortIndex} result]} {
- set ok 1
- set needs_portindex false
- ui_debug "successful verification with key $pubkey"
- break
- } else {
- ui_debug "failed verification with key $pubkey"
- ui_debug "openssl output: $result"
- }
+ system $rsync_commandline
+ foreach pubkey $macports::archivefetch_pubkeys {
+ try -pass_signal {
+ exec $openssl dgst -ripemd160 -verify $pubkey -signature ${destdir}/PortIndex.rmd160 ${destdir}/PortIndex
+ set ok 1
+ set needs_portindex false
+ ui_debug "successful verification with key $pubkey"
+ break
+ } catch {{*} eCode eMessage} {
+ ui_debug "failed verification with key $pubkey"
+ ui_debug "openssl output: $eMessage"
}
- if {$ok} {
- # move PortIndex into place
- file rename -force ${destdir}/PortIndex ${destdir}/ports/
- }
}
+ if {$ok} {
+ # move PortIndex into place
+ file rename -force ${destdir}/PortIndex ${destdir}/ports/
+ }
}
if {$ok} {
mports_generate_quickindex $indexfile
}
+ } catch {*} {
+ ui_debug "Synchronization of the PortIndex failed doing rsync"
}
}
- if {[catch {system "chmod -R a+r \"$destdir\""}]} {
+ try -pass_signal {
+ system [list chmod -R a+r $destdir]
+ } catch {*} {
ui_warn "Setting world read permissions on parts of the ports tree failed, need root?"
}
}
@@ -2601,6 +2645,7 @@
set updated 1
if {[file isdirectory $destdir]} {
set moddate [file mtime $destdir]
+ # XXX, catch, don't fix rarely used code
if {[catch {set updated [curl isnewer $source $moddate]} error]} {
ui_warn "Cannot check if $source was updated, ($error)"
}
@@ -2621,13 +2666,8 @@
set progressflag "--progress ${macports::ui_options(progress_download)}"
set verboseflag ""
}
-
- try {
+ try -pass_signal {
curl fetch {*}$progressflag $source $tarpath
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- throw
} catch {{*} eCode eMessage} {
ui_error [msgcat::mc "Fetching %s failed: %s" $source $eMessage]
incr numfailed
@@ -2746,10 +2786,10 @@
foreach source $sources {
set source [lindex $source 0]
set protocol [macports::getprotocol $source]
- if {[catch {set fd [open [macports::getindex $source] r]} result]} {
- ui_warn "Can't open index file for source: $source"
- } else {
- try {
+ try -pass_signal {
+ set fd [open [macports::getindex $source] r]
+
+ try -pass_signal {
incr found 1
while {[gets $fd line] >= 0} {
array unset portinfo
@@ -2831,6 +2871,8 @@
} finally {
close $fd
}
+ } catch {*} {
+ ui_warn "Can't open index file for source: $source"
}
}
if {!$found} {
@@ -2874,7 +2916,7 @@
if {[catch {set fd [open [macports::getindex $source] r]} result]} {
ui_warn "Can't open index file for source: $source"
} else {
- try {
+ try -pass_signal {
seek $fd $offset
gets $fd line
set name [lindex $line 0]
@@ -2901,14 +2943,10 @@
}
lappend matches $name
lappend matches $line
- close $fd
- set fd -1
} catch * {
ui_warn "It looks like your PortIndex file for $source may be corrupt."
} finally {
- if {$fd != -1} {
- close $fd
- }
+ close $fd
}
if {[llength $matches] > 0} {
# if we have a match, exit. If we don't, continue with the next
@@ -2937,8 +2975,10 @@
foreach source $sources {
set source [lindex $source 0]
set protocol [macports::getprotocol $source]
- if {![catch {set fd [open [macports::getindex $source] r]} result]} {
- try {
+ try -pass_signal {
+ set fd [open [macports::getindex $source] r]
+
+ try -pass_signal {
incr found 1
while {[gets $fd line] >= 0} {
array unset portinfo
@@ -2972,7 +3012,7 @@
} finally {
close $fd
}
- } else {
+ } catch {*} {
ui_warn "Can't open index file for source: $source"
}
}
@@ -3004,21 +3044,24 @@
}
if {![file exists ${index}.quick]} {
ui_warn "No quick index file found, attempting to generate one for source: $source"
- if {[catch {set quicklist [mports_generate_quickindex $index]}]} {
+ try -pass_signal {
+ set quicklist [mports_generate_quickindex $index]
+ } catch {*} {
incr sourceno
continue
}
}
# only need to read the quick index file if we didn't just update it
if {![info exists quicklist]} {
- if {[catch {set fd [open ${index}.quick r]} result]} {
+ try -pass_signal {
+ set fd [open ${index}.quick r]
+ } catch {*} {
ui_warn "Can't open quick index file for source: $source"
incr sourceno
continue
- } else {
- set quicklist [read $fd]
- close $fd
}
+ set quicklist [read $fd]
+ close $fd
}
foreach entry [split $quicklist \n] {
set quick_index(${sourceno},[lindex $entry 0]) [lindex $entry 1]
@@ -3045,34 +3088,38 @@
# is corrupt), or the quick index generation failed for some other
# reason.
proc mports_generate_quickindex {index} {
- if {[catch {set indexfd [open $index r]} result] || [catch {set quickfd [open ${index}.quick w]} result]} {
+ try -pass_signal {
+ set indexfd -1
+ set quickfd -1
+ set indexfd [open $index r]
+ set quickfd [open ${index}.quick w]
+ } catch {*} {
ui_warn "Can't open index file: $index"
return -code error
- } else {
- try {
- set offset [tell $indexfd]
- set quicklist {}
- while {[gets $indexfd line] >= 0} {
- if {[llength $line] != 2} {
- continue
- }
- set name [lindex $line 0]
- append quicklist "[string tolower $name] $offset\n"
-
- set len [lindex $line 1]
- read $indexfd $len
- set offset [tell $indexfd]
+ }
+ try -pass_signal {
+ set offset [tell $indexfd]
+ set quicklist {}
+ while {[gets $indexfd line] >= 0} {
+ if {[llength $line] != 2} {
+ continue
}
- puts -nonewline $quickfd $quicklist
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- throw
- } catch {{*} eCode eMessage} {
- ui_warn "It looks like your PortIndex file $index may be corrupt."
- throw
- } finally {
+ set name [lindex $line 0]
+ append quicklist "[string tolower $name] $offset\n"
+
+ set len [lindex $line 1]
+ read $indexfd $len
+ set offset [tell $indexfd]
+ }
+ puts -nonewline $quickfd $quicklist
+ } catch {{*} eCode eMessage} {
+ ui_warn "It looks like your PortIndex file $index may be corrupt."
+ throw
+ } finally {
+ if {$indexfd != -1} {
close $indexfd
+ }
+ if {$quickfd != -1} {
close $quickfd
}
}
@@ -3235,11 +3282,13 @@
}
if {$parse} {
# Find the porturl
- if {[catch {set res [mportlookup $dep_portname]} error]} {
+ try -pass_signal {
+ set res [mportlookup $dep_portname]
+ } catch {{*} eCode eMessage} {
global errorInfo
ui_msg {}
ui_debug $errorInfo
- ui_error "Internal error: port lookup failed: $error"
+ ui_error "Internal error: port lookup failed: $eMessage"
return 1
}
@@ -3496,186 +3545,7 @@
# selfupdate procedure
proc macports::selfupdate {{optionslist {}} {updatestatusvar {}}} {
- global macports::prefix macports::portdbpath macports::rsync_server macports::rsync_dir \
- macports::rsync_options macports::autoconf::macports_version \
- macports::autoconf::rsync_path tcl_platform macports::autoconf::openssl_path \
- macports::autoconf::tar_path
- array set options $optionslist
-
- # variable that indicates whether we actually updated base
- if {$updatestatusvar ne ""} {
- upvar $updatestatusvar updatestatus
- set updatestatus no
- }
-
- # are we syncing a tarball? (implies detached signature)
- set is_tarball 0
- if {[string range $rsync_dir end-3 end] eq ".tar"} {
- set is_tarball 1
- set mp_source_path [file join $portdbpath sources $rsync_server [file dirname $rsync_dir]]
- } else {
- if {[string index $rsync_dir end] ne "/"} {
- append rsync_dir /
- }
- set mp_source_path [file join $portdbpath sources $rsync_server $rsync_dir]
- }
- # create the path to the to be downloaded sources if it doesn't exist
- if {![file exists $mp_source_path]} {
- file mkdir $mp_source_path
- }
- ui_debug "MacPorts sources location: $mp_source_path"
-
- # sync the MacPorts sources
- ui_msg "$macports::ui_prefix Updating MacPorts base sources using rsync"
- if {[catch {system "$rsync_path $rsync_options rsync://${rsync_server}/$rsync_dir $mp_source_path"} result]} {
- return -code error "Error synchronizing MacPorts sources: $result"
- }
-
- if {$is_tarball} {
- # verify signature for tarball
- global macports::archivefetch_pubkeys
- if {[catch {system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir}.rmd160 $mp_source_path"} result]} {
- return -code error "Error synchronizing MacPorts source signature: $result"
- }
- set openssl [findBinary openssl $macports::autoconf::openssl_path]
- set tarball ${mp_source_path}/[file tail $rsync_dir]
- set signature ${tarball}.rmd160
- set verified 0
- foreach pubkey $macports::archivefetch_pubkeys {
- if {![catch {exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature $tarball} result]} {
- set verified 1
- ui_debug "successful verification with key $pubkey"
- break
- } else {
- ui_debug "failed verification with key $pubkey"
- ui_debug "openssl output: $result"
- }
- }
- if {!$verified} {
- return -code error "Failed to verify signature for MacPorts source!"
- }
-
- # extract tarball and move into place
- set tar [macports::findBinary tar $macports::autoconf::tar_path]
- file mkdir ${mp_source_path}/tmp
- set tar_cmd "$tar -C ${mp_source_path}/tmp -xf $tarball"
- ui_debug $tar_cmd
- if {[catch {system $tar_cmd}]} {
- return -code error "Failed to extract MacPorts sources from tarball!"
- }
- file delete -force ${mp_source_path}/base
- file rename ${mp_source_path}/tmp/base ${mp_source_path}/base
- file delete -force ${mp_source_path}/tmp
- # set the final extracted source path
- set mp_source_path ${mp_source_path}/base
- }
-
- # echo current MacPorts version
- ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
-
- if {[info exists options(ports_force)] && $options(ports_force)} {
- set use_the_force_luke yes
- ui_debug "Forcing a rebuild and reinstallation of MacPorts"
- } else {
- set use_the_force_luke no
- ui_debug "Rebuilding and reinstalling MacPorts if needed"
- }
-
- # Choose what version file to use: old, floating point format or new, real version number format
- set version_file [file join $mp_source_path config macports_version]
- if {[file exists $version_file]} {
- set fd [open $version_file r]
- gets $fd macports_version_new
- close $fd
- # echo downloaded MacPorts version
- ui_msg "MacPorts base version $macports_version_new downloaded."
- } else {
- ui_warn "No version file found, please rerun selfupdate."
- set macports_version_new 0
- }
-
- # check if we we need to rebuild base
- set comp [vercmp $macports_version_new $macports::autoconf::macports_version]
-
- # syncing ports tree.
- if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
- if {$comp > 0} {
- # updated portfiles potentially need new base to parse - tell sync to try to
- # use prefabricated PortIndex files and signal if it couldn't
- lappend optionslist no_reindex 1 needed_portindex_var needed_portindex
- }
- if {[catch {mportsync $optionslist} result]} {
- return -code error "Couldn't sync the ports tree: $result"
- }
- }
-
- if {$use_the_force_luke || $comp > 0} {
- if {[info exists options(ports_dryrun)] && $options(ports_dryrun)} {
- ui_msg "$macports::ui_prefix MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
- } else {
- ui_msg "$macports::ui_prefix MacPorts base is outdated, installing new version $macports_version_new"
-
- # get installation user/group and permissions
- set owner [file attributes $prefix -owner]
- set group [file attributes $prefix -group]
- set perms [string range [file attributes $prefix -permissions] end-3 end]
- if {$tcl_platform(user) ne "root" && $tcl_platform(user) ne $owner} {
- return -code error "User $tcl_platform(user) does not own $prefix - try using sudo"
- }
- ui_debug "Permissions OK"
-
- set configure_args "--prefix=[macports::shellescape $prefix] --with-install-user=[macports::shellescape $owner] --with-install-group=[macports::shellescape $group] --with-directory-mode=[macports::shellescape $perms]"
- # too many users have an incompatible readline in /usr/local, see ticket #10651
- if {$tcl_platform(os) ne "Darwin" || $prefix eq "/usr/local"
- || ([glob -nocomplain /usr/local/lib/lib{readline,history}*] eq "" && [glob -nocomplain /usr/local/include/readline/*.h] eq "")} {
- append configure_args " --enable-readline"
- } else {
- ui_warn "Disabling readline support due to readline in /usr/local"
- }
-
- if {$prefix eq "/usr/local" || $prefix eq "/usr"} {
- append configure_args " --with-unsupported-prefix"
- }
-
- # Choose a sane compiler
- set cc_arg {}
- if {$::macports::os_platform eq "darwin"} {
- set cc_arg "CC=/usr/bin/cc OBJC=/usr/bin/cc "
- }
-
- # do the actual configure, build and installation of new base
- ui_msg "Installing new MacPorts release in $prefix as ${owner}:${group}; permissions ${perms}\n"
- if {[catch {system "cd $mp_source_path && ${cc_arg}./configure $configure_args && make SELFUPDATING=1 && make install SELFUPDATING=1"} result]} {
- return -code error "Error installing new MacPorts base: $result"
- }
- if {[info exists updatestatus]} {
- set updatestatus yes
- }
- }
- } elseif {$comp < 0} {
- ui_msg "$macports::ui_prefix MacPorts base is probably trunk or a release candidate"
- } else {
- ui_msg "$macports::ui_prefix MacPorts base is already the latest version"
- }
-
- # set the MacPorts sources to the right owner
- set sources_owner [file attributes [file join $portdbpath sources/] -owner]
- ui_debug "Setting MacPorts sources ownership to $sources_owner"
- if {[catch {exec [findBinary chown $macports::autoconf::chown_path] -R $sources_owner [file join $portdbpath sources/]} result]} {
- return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to ${sources_owner}: $result"
- }
-
- if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
- if {[info exists needed_portindex]} {
- ui_msg "Not all sources could be fully synced using the old version of MacPorts."
- ui_msg "Please run selfupdate again now that MacPorts base has been updated."
- } else {
- ui_msg "\nThe ports tree has been updated. To upgrade your installed ports, you should run"
- ui_msg " port upgrade outdated"
- }
- }
-
- return 0
+ return [uplevel [list selfupdate::main $optionslist $updatestatusvar]]
}
# upgrade API wrapper procedure
@@ -3744,10 +3614,13 @@
}
# check if the port is in tree
- if {[catch {mportlookup $portname} result]} {
+ set result ""
+ try {
+ set result [mportlookup $portname]
+ } catch {{*} eCode eMessage} {
global errorInfo
ui_debug $errorInfo
- ui_error "port lookup failed: $result"
+ ui_error "port lookup failed: $eMessage"
return 1
}
# argh! port doesnt exist!
@@ -4467,7 +4340,6 @@
}
proc macports::reclaim_main {} {
-
# Calls the main function for the 'port reclaim' command.
#
# Args:
@@ -4475,7 +4347,19 @@
# Returns:
# None
- reclaim::main
+ try {
+ reclaim::main
+ } catch {{POSIX SIG SIGINT} eCode eMessage} {
+ ui_error [msgcat::mc "reclaim aborted: SIGINT received."]
+ return 2
+ } catch {{POSIX SIG SIGTERM} eCode eMessage} {
+ ui_error [msgcat::mc "reclaim aborted: SIGTERM received."]
+ return 2
+ } catch {{*} eCode eMessage} {
+ ui_debug "reclaim failed: $::errorInfo"
+ ui_error [msgcat::mc "reclaim failed: %s" $eMessage]
+ return 1
+ }
return 0
}
@@ -4559,12 +4443,26 @@
ui_debug "Updating binary flag for file $i of ${files_count}: $fpath"
incr i
- if {0 != [catch {$f binary [fileIsBinary $fpath]} fileIsBinaryError]} {
- # handle errors (e.g. file not found, permission denied) gracefully
+ try {
+ $f binary [fileIsBinary $fpath]
+ } catch {{POSIX SIG SIGINT} eCode eMessage} {
if {$fancy_output} {
$revupgrade_progress intermission
}
- ui_warn "Error determining file type of `$fpath': $fileIsBinaryError"
+ ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
+ throw
+ } catch {{POSIX SIG SIGTERM} eCode eMessage} {
+ if {$fancy_output} {
+ $revupgrade_progress intermission
+ }
+ ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
+ throw
+ } catch {{*} eCode eMessage} {
+ if {$fancy_output} {
+ $revupgrade_progress intermission
+ }
+ # handle errors (e.g. file not found, permission denied) gracefully
+ ui_warn "Error determining file type of `$fpath': $eMessage"
ui_warn "A file belonging to the `[[registry::entry owner $fpath] name]' port is missing or unreadable. Consider reinstalling it."
}
}
@@ -4633,7 +4531,9 @@
if {[$architecture cget -mat_install_name] ne "NULL" && [$architecture cget -mat_install_name] ne ""} {
# check if this lib's install name actually refers to this file itself
# if this is not the case software linking against this library might have erroneous load commands
- if {0 == [catch {set idloadcmdpath [revupgrade_handle_special_paths $bpath [$architecture cget -mat_install_name]]}]} {
+
+ try {
+ set idloadcmdpath [revupgrade_handle_special_paths $bpath [$architecture cget -mat_install_name]]
if {[string index $idloadcmdpath 0] ne "/"} {
set port [registry::entry owner $bpath]
if {$port ne ""} {
@@ -4675,7 +4575,19 @@
ui_warn "This is probably a bug in the $portname port and might cause problems in libraries linking against this file"
}
}
- }
+ } catch {{POSIX SIG SIGINT} eCode eMessage} {
+ if {$fancy_output} {
+ $revupgrade_progress intermission
+ }
+ ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
+ throw
+ } catch {{POSIX SIG SIGTERM} eCode eMessage} {
+ if {$fancy_output} {
+ $revupgrade_progress intermission
+ }
+ ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
+ throw
+ } catch {*} {}
}
}
@@ -4689,7 +4601,21 @@
set loadcommand [$architecture cget -mat_loadcmds]
while {$loadcommand ne "NULL"} {
- if {0 != [catch {set filepath [revupgrade_handle_special_paths $bpath [$loadcommand cget -mlt_install_name]]}]} {
+ try {
+ set filepath [revupgrade_handle_special_paths $bpath [$loadcommand cget -mlt_install_name]]
+ } catch {{POSIX SIG SIGINT} eCode eMessage} {
+ if {$fancy_output} {
+ $revupgrade_progress intermission
+ }
+ ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
+ throw
+ } catch {{POSIX SIG SIGTERM} eCode eMessage} {
+ if {$fancy_output} {
+ $revupgrade_progress intermission
+ }
+ ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
+ throw
+ } catch {*} {
set loadcommand [$loadcommand cget -next]
continue;
}
Modified: branches/vcs-fetch/base/src/macports1.0/macports_util.tcl
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/macports_util.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/macports_util.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -176,6 +176,64 @@
}
macports_util::method_wrap lunshift
+
+# bytesize filesize ?unit? ?format?
+# Format an integer representing bytes using given units
+proc bytesize {siz {unit {}} {format {%.3f}}} {
+ if {$unit == {}} {
+ if {$siz > 0x40000000} {
+ set unit "GiB"
+ } elseif {$siz > 0x100000} {
+ set unit "MiB"
+ } elseif {$siz > 0x400} {
+ set unit "KiB"
+ } else {
+ set unit "B"
+ }
+ }
+ switch -- $unit {
+ KiB {
+ set siz [expr {$siz / 1024.0}]
+ }
+ kB {
+ set siz [expr {$siz / 1000.0}]
+ }
+ MiB {
+ set siz [expr {$siz / 1048576.0}]
+ }
+ MB {
+ set siz [expr {$siz / 1000000.0}]
+ }
+ GiB {
+ set siz [expr {$siz / 1073741824.0}]
+ }
+ GB {
+ set siz [expr {$siz / 1000000000.0}]
+ }
+ B { }
+ default {
+ ui_warn "Unknown file size unit '$unit' specified"
+ set unit "B"
+ }
+ }
+ if {[expr {round($siz)}] != $siz} {
+ set siz [format $format $siz]
+ }
+ return "$siz $unit"
+}
+
+# filesize file ?unit?
+# Return size of file in human-readable format
+# In case of any errors, returns -1
+proc filesize {fil {unit {}}} {
+ set siz -1
+ catch {
+ set siz [bytesize [file size $fil] $unit]
+ }
+ return $siz
+}
+
+
################################
# try/catch exception handling #
################################
@@ -220,15 +278,27 @@
}
}
-# try body ?catch {type_list ?ecvar? ?msgvar? ?infovar?} body ...? ?finally body?
+# try ?-pass_signal? body ?catch {type_list ?ecvar? ?msgvar? ?infovar?} body ...? ?finally body?
# implementation of try as specified in TIP #89
+# option -pass_signal passes SIGINT and SIGTERM signals up the stack
proc try {args} {
# validate and interpret the arguments
set catchList {}
if {[llength $args] == 0} {
return -code error "wrong # args: \
- should be \"try body ?catch {type-list ?ecvar? ?msgvar? ?infovar?} body ...? ?finally body?\""
+ should be \"try ?-pass_signal? body ?catch {type-list ?ecvar? ?msgvar? ?infovar?} body ...? ?finally body?\""
}
+ if {[lindex $args 0] eq "-pass_signal"} {
+ lpush catchList {{POSIX SIG SIGINT} eCode eMessage} {
+ ui_debug [msgcat::mc "Aborted: SIGINT signal received"]
+ throw
+ }
+ lpush catchList {{POSIX SIG SIGTERM} eCode eMessage} {
+ ui_debug [msgcat::mc "Aborted: SIGTERM signal received"]
+ throw
+ }
+ lshift args
+ }
set body [lshift args]
while {[llength $args] > 0} {
set arg [lshift args]
Modified: branches/vcs-fetch/base/src/macports1.0/reclaim.tcl
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/reclaim.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/reclaim.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -137,9 +137,11 @@
set variants [lindex $port 3]
# Get mport reference
- if {[catch {set mport [mportopen_installed $name $version $revision $variants {}]} error]} {
+ try -pass_signal {
+ set mport [mportopen_installed $name $version $revision $variants {}]
+ } catch {{*} eCode eMessage} {
$progress intermission
- ui_warn [msgcat::mc "Failed to open port %s from registry: %s" $name $error]
+ ui_warn [msgcat::mc "Failed to open port %s from registry: %s" $name $eMessage]
continue
}
@@ -193,61 +195,60 @@
incr size_superfluous_files [file size $f]
}
if {[llength $superfluous_files] > 0} {
- ui_msg [msgcat::mc \
- "Found %d files (total %s) that are no longer needed and can be deleted." \
- $num_superfluous_files \
- [bytesize $size_superfluous_files]]
- while {1} {
- ui_msg "\[D]elete / \[k]eep / \[l]ist: "
- switch [gets stdin] {
- d -
- D {
- ui_msg "Deleting..."
- foreach f $superfluous_files {
- set root_length [string length "${root_dist}/"]
- set home_length [string length "${home_dist}/"]
+ if {[info exists macports::ui_options(questions_alternative)]} {
+ array set alternatives {d delete k keep l list}
+ while 1 {
+ set retstring [$macports::ui_options(questions_alternative) [msgcat::mc \
+ "Found %d files (total %s) that are no longer needed and can be deleted." \
+ $num_superfluous_files [bytesize $size_superfluous_files]] "deleteFilesQ" "alternatives" {k}]
+
+ switch $retstring {
+ d {
+ ui_msg "Deleting..."
+ foreach f $superfluous_files {
+ set root_length [string length "${root_dist}/"]
+ set home_length [string length "${home_dist}/"]
- try {
- ui_info [msgcat::mc "Deleting unused file %s" $f]
- file delete -- $f
+ try -pass_signal {
+ ui_info [msgcat::mc "Deleting unused file %s" $f]
+ file delete -- $f
- set directory [file dirname $f]
- while {1} {
- set is_below_root [string equal -length $root_length $directory "${root_dist}/"]
- set is_below_home [string equal -length $home_length $directory "${home_dist}/"]
+ set directory [file dirname $f]
+ while {1} {
+ set is_below_root [string equal -length $root_length $directory "${root_dist}/"]
+ set is_below_home [string equal -length $home_length $directory "${home_dist}/"]
- if {!$is_below_root && !$is_below_home} {
- break
- }
+ if {!$is_below_root && !$is_below_home} {
+ break
+ }
- if {[llength [readdir $directory]] > 0} {
- break
- }
+ if {[llength [readdir $directory]] > 0} {
+ break
+ }
- ui_info [msgcat::mc "Deleting empty directory %s" $directory]
- try {
- file delete -- $directory
- } catch {{*} eCode eMessage} {
- ui_warn [msgcat::mc "Could not delete empty directory %s: %s" $directory $eMesage]
+ ui_info [msgcat::mc "Deleting empty directory %s" $directory]
+ try -pass_signal {
+ file delete -- $directory
+ } catch {{*} eCode eMessage} {
+ ui_warn [msgcat::mc "Could not delete empty directory %s: %s" $directory $eMesage]
+ }
+ set directory [file dirname $directory]
}
- set directory [file dirname $directory]
+ } catch {{*} eCode eMessage} {
+ ui_warn [msgcat::mc "Could not delete %s: %s" $f $eMessage]
}
- } catch {{*} eCode eMessage} {
- ui_warn [msgcat::mc "Could not delete %s: %s" $f $eMessage]
}
+ break
}
- break
- }
- k -
- K {
- ui_msg "OK, keeping the files."
- break
- }
- l -
- L {
- foreach f $superfluous_files {
- ui_msg " $f"
+ k {
+ ui_msg "OK, keeping the files."
+ break
}
+ l {
+ foreach f $superfluous_files {
+ ui_msg " $f"
+ }
+ }
}
}
}
@@ -258,19 +259,6 @@
return 0
}
- proc close_file {file} {
-
- # Closes the file, handling error catching if needed.
- #
- # Args:
- # file - The file handler
- # Returns:
- # None
- if {[catch {close $file} error]} {
- ui_error "something went wrong when closing file, $file."
- }
- }
-
proc is_inactive {port} {
# Determines whether a port is inactive or not.
@@ -298,12 +286,12 @@
# A multidimensional list where each port is a sublist, i.e., [{first port info} {second port info} {...}]
# Indexes of each sublist are: 0 = name, 1 = version, 2 = revision, 3 = variants, 4 = activity, and 5 = epoch.
- if {[catch {set installed [registry::installed]} result]} {
+ try -pass_signal {
+ return [registry::installed]
+ } catch {*} {
ui_error "no installed ports found."
return {}
}
-
- return $installed
}
proc update_last_run {} {
@@ -317,10 +305,18 @@
ui_debug "Updating last run information."
- set path [file join ${macports::portdbpath} last_reclaim]
- set fd [open $path w]
- puts $fd [clock seconds]
- close_file $fd
+ set path [file join ${macports::portdbpath} last_reclaim]
+ set fd -1
+ try -pass_signal {
+ set fd [open $path w]
+ puts $fd [clock seconds]
+ } catch {*} {
+ # Ignore error silently
+ } finally {
+ if {$fd != -1} {
+ close $fd
+ }
+ }
}
proc check_last_run {} {
@@ -336,15 +332,26 @@
set path [file join ${macports::portdbpath} last_reclaim]
- if {[file exists $path]} {
-
- set fd [open $path r]
- set time [gets $fd]
- close_file $fd
-
- if {$time ne ""} {
- if {[clock seconds] - $time > 1209600} {
- ui_warn "You haven't run 'port reclaim' in two weeks. It's recommended you run this every two weeks to reclaim disk space."
+ set fd -1
+ set time ""
+ try -pass_signal {
+ set fd [open $path r]
+ set time [gets $fd]
+ } catch {*} {
+ # Ignore error silently; the file might not have been created yet
+ } finally {
+ if {$fd != -1} {
+ close $fd
+ }
+ }
+ if {$time ne ""} {
+ if {[clock seconds] - $time > 1209600} {
+ if {[info exists macports::ui_options(questions_yesno)]} {
+ set retval [$macports::ui_options(questions_yesno) "You haven't run 'port reclaim' in two weeks. It's recommended you run this every two weeks to reclaim disk space." "ReclaimPrompt" "" {y} 0 "Would you like to run it now?"]
+ if {$retval == 0} {
+ # User said yes, run port reclaim
+ macports::reclaim_main
+ }
}
}
}
@@ -381,38 +388,26 @@
} else {
ui_msg "Found inactive ports: $inactive_names."
- ui_msg "Would you like to uninstall these ports? \[y/N\]: "
+ if {[info exists macports::ui_options(questions_multichoice)]} {
+ set retstring [$macports::ui_options(questions_multichoice) "Would you like to uninstall these ports?" "" $inactive_names]
- set input [gets stdin]
- if {$input eq "Y" || $input eq "y" } {
+ if {[llength $retstring] > 0} {
+ foreach i $retstring {
+ set port [lindex $inactive_ports $i]
+ set name [lindex $port 0]
- ui_debug "Iterating through all inactive ports... again."
+ ui_msg "Uninstalling: $name"
- foreach port $inactive_ports {
- set name [lindex $port 0]
-
- # Get all dependents of the current port
- if {[catch {set dependents [registry::list_dependents $name [lindex 1] [lindex 2] [lindex 3]]} error]} {
- ui_error "something went wrong when trying to enumerate all dependents of $name"
- }
- if {${dependents} ne ""} {
- ui_warn "Port $name is a dependent of $dependents. Do you want to uninstall this port at the risk of breaking other ports? \[Y/n\]"
-
- set input [gets stdin]
- if { $input eq "N" || "n" } {
- ui_msg "Skipping port."
- continue
+ # Note: 'uninstall' takes a name, version, revision, variants and an options list.
+ try -pass_signal {
+ registry_uninstall::uninstall $name [lindex $port 1] [lindex $port 2] [lindex $port 3] {}
+ } catch {{*} eCode eMessage} {
+ ui_error "Error uninstalling $name: $eMessage"
}
}
- ui_msg "Uninstalling: $name"
-
- # Note: 'uninstall' takes a name, version, revision, variants and an options list.
- if {[catch {registry_uninstall::uninstall $name [lindex $port 1] [lindex $port 2] [lindex $port 3] {}} error]} {
- ui_error "something went wrong when uninstalling $name"
- }
+ } else {
+ ui_msg "Not uninstalling ports."
}
- } else {
- ui_msg "Not uninstalling ports."
}
}
return 0
Copied: branches/vcs-fetch/base/src/macports1.0/selfupdate.tcl (from rev 147030, trunk/base/src/macports1.0/selfupdate.tcl)
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/selfupdate.tcl (rev 0)
+++ branches/vcs-fetch/base/src/macports1.0/selfupdate.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -0,0 +1,233 @@
+# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:filetype=tcl:et:sw=4:ts=4:sts=4
+# selfupdate.tcl
+# $Id$
+#
+# Copyright (c) 2016 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 selfupdate 1.0
+
+package require macports
+
+namespace eval selfupdate {
+ namespace export main
+}
+
+proc selfupdate::main {{optionslist {}} {updatestatusvar {}}} {
+ global macports::prefix macports::portdbpath macports::rsync_server macports::rsync_dir \
+ macports::rsync_options macports::autoconf::macports_version \
+ macports::autoconf::rsync_path tcl_platform macports::autoconf::openssl_path \
+ macports::autoconf::tar_path
+ array set options $optionslist
+
+ # variable that indicates whether we actually updated base
+ if {$updatestatusvar ne ""} {
+ upvar $updatestatusvar updatestatus
+ set updatestatus no
+ }
+
+ # are we syncing a tarball? (implies detached signature)
+ set is_tarball 0
+ if {[string range $rsync_dir end-3 end] eq ".tar"} {
+ set is_tarball 1
+ set mp_source_path [file join $portdbpath sources $rsync_server [file dirname $rsync_dir]]
+ } else {
+ if {[string index $rsync_dir end] ne "/"} {
+ append rsync_dir /
+ }
+ set mp_source_path [file join $portdbpath sources $rsync_server $rsync_dir]
+ }
+ # create the path to the to be downloaded sources if it doesn't exist
+ if {![file exists $mp_source_path]} {
+ file mkdir $mp_source_path
+ }
+ ui_debug "MacPorts sources location: $mp_source_path"
+
+ # sync the MacPorts sources
+ ui_msg "$macports::ui_prefix Updating MacPorts base sources using rsync"
+ try -pass_signal {
+ system "$rsync_path $rsync_options rsync://${rsync_server}/$rsync_dir $mp_source_path"
+ } catch {{*} eCode eMessage} {
+ return -code error "Error synchronizing MacPorts sources: $eMessage"
+ }
+
+ if {$is_tarball} {
+ # verify signature for tarball
+ global macports::archivefetch_pubkeys
+ try -pass_signal {
+ system "$rsync_path $rsync_options rsync://${rsync_server}/${rsync_dir}.rmd160 $mp_source_path"
+ } catch {{*} eCode eMessage} {
+ return -code error "Error synchronizing MacPorts source signature: $eMessage"
+ }
+ set openssl [macports::findBinary openssl $macports::autoconf::openssl_path]
+ set tarball ${mp_source_path}/[file tail $rsync_dir]
+ set signature ${tarball}.rmd160
+ set verified 0
+ foreach pubkey $macports::archivefetch_pubkeys {
+ try -pass_signal {
+ exec $openssl dgst -ripemd160 -verify $pubkey -signature $signature $tarball
+ set verified 1
+ ui_debug "successful verification with key $pubkey"
+ break
+ } catch {{*} eCode eMessage} {
+ ui_debug "failed verification with key $pubkey"
+ ui_debug "openssl output: $eMessage"
+ }
+ }
+ if {!$verified} {
+ return -code error "Failed to verify signature for MacPorts source!"
+ }
+
+ # extract tarball and move into place
+ set tar [macports::findBinary tar $macports::autoconf::tar_path]
+ file mkdir ${mp_source_path}/tmp
+ set tar_cmd "$tar -C ${mp_source_path}/tmp -xf $tarball"
+ try -pass_signal {
+ system $tar_cmd
+ } catch {*} {
+ return -code error "Failed to extract MacPorts sources from tarball!"
+ }
+ file delete -force ${mp_source_path}/base
+ file rename ${mp_source_path}/tmp/base ${mp_source_path}/base
+ file delete -force ${mp_source_path}/tmp
+ # set the final extracted source path
+ set mp_source_path ${mp_source_path}/base
+ }
+
+ # echo current MacPorts version
+ ui_msg "MacPorts base version $macports::autoconf::macports_version installed,"
+
+ if {[info exists options(ports_force)] && $options(ports_force)} {
+ set use_the_force_luke yes
+ ui_debug "Forcing a rebuild and reinstallation of MacPorts"
+ } else {
+ set use_the_force_luke no
+ ui_debug "Rebuilding and reinstalling MacPorts if needed"
+ }
+
+ # Choose what version file to use: old, floating point format or new, real version number format
+ set version_file [file join $mp_source_path config macports_version]
+ if {[file exists $version_file]} {
+ set fd [open $version_file r]
+ gets $fd macports_version_new
+ close $fd
+ # echo downloaded MacPorts version
+ ui_msg "MacPorts base version $macports_version_new downloaded."
+ } else {
+ ui_warn "No version file found, please rerun selfupdate."
+ set macports_version_new 0
+ }
+
+ # check if we we need to rebuild base
+ set comp [vercmp $macports_version_new $macports::autoconf::macports_version]
+
+ # syncing ports tree.
+ if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
+ if {$comp > 0} {
+ # updated portfiles potentially need new base to parse - tell sync to try to
+ # use prefabricated PortIndex files and signal if it couldn't
+ lappend optionslist no_reindex 1 needed_portindex_var needed_portindex
+ }
+ try {
+ mportsync $optionslist
+ } catch {{*} eCode eMessage} {
+ return -code error "Couldn't sync the ports tree: $eMessage"
+ }
+ }
+
+ if {$use_the_force_luke || $comp > 0} {
+ if {[info exists options(ports_dryrun)] && $options(ports_dryrun)} {
+ ui_msg "$macports::ui_prefix MacPorts base is outdated, selfupdate would install $macports_version_new (dry run)"
+ } else {
+ ui_msg "$macports::ui_prefix MacPorts base is outdated, installing new version $macports_version_new"
+
+ # get installation user/group and permissions
+ set owner [file attributes $prefix -owner]
+ set group [file attributes $prefix -group]
+ set perms [string range [file attributes $prefix -permissions] end-3 end]
+ if {$tcl_platform(user) ne "root" && $tcl_platform(user) ne $owner} {
+ return -code error "User $tcl_platform(user) does not own $prefix - try using sudo"
+ }
+ ui_debug "Permissions OK"
+
+ set configure_args "--prefix=[macports::shellescape $prefix] --with-install-user=[macports::shellescape $owner] --with-install-group=[macports::shellescape $group] --with-directory-mode=[macports::shellescape $perms]"
+ # too many users have an incompatible readline in /usr/local, see ticket #10651
+ if {$tcl_platform(os) ne "Darwin" || $prefix eq "/usr/local"
+ || ([glob -nocomplain /usr/local/lib/lib{readline,history}*] eq "" && [glob -nocomplain /usr/local/include/readline/*.h] eq "")} {
+ append configure_args " --enable-readline"
+ } else {
+ ui_warn "Disabling readline support due to readline in /usr/local"
+ }
+
+ if {$prefix eq "/usr/local" || $prefix eq "/usr"} {
+ append configure_args " --with-unsupported-prefix"
+ }
+
+ # Choose a sane compiler
+ set cc_arg {}
+ if {$::macports::os_platform eq "darwin"} {
+ set cc_arg "CC=/usr/bin/cc OBJC=/usr/bin/cc "
+ }
+
+ # do the actual configure, build and installation of new base
+ ui_msg "Installing new MacPorts release in $prefix as ${owner}:${group}; permissions ${perms}\n"
+ try {
+ system -W $mp_source_path "${cc_arg}./configure $configure_args && make SELFUPDATING=1 && make install SELFUPDATING=1"
+ } catch {{*} eCode eMessage} {
+ return -code error "Error installing new MacPorts base: $eMessage"
+ }
+ if {[info exists updatestatus]} {
+ set updatestatus yes
+ }
+ }
+ } elseif {$comp < 0} {
+ ui_msg "$macports::ui_prefix MacPorts base is probably trunk or a release candidate"
+ } else {
+ ui_msg "$macports::ui_prefix MacPorts base is already the latest version"
+ }
+
+ # set the MacPorts sources to the right owner
+ set sources_owner [file attributes [file join $portdbpath sources/] -owner]
+ ui_debug "Setting MacPorts sources ownership to $sources_owner"
+ try {
+ exec [macports::findBinary chown $macports::autoconf::chown_path] -R $sources_owner [file join $portdbpath sources/]
+ } catch {{*} eCode eMessage} {
+ return -code error "Couldn't change permissions of the MacPorts sources at $mp_source_path to ${sources_owner}: $eMessage"
+ }
+
+ if {![info exists options(ports_selfupdate_nosync)] || !$options(ports_selfupdate_nosync)} {
+ if {[info exists needed_portindex]} {
+ ui_msg "Not all sources could be fully synced using the old version of MacPorts."
+ ui_msg "Please run selfupdate again now that MacPorts base has been updated."
+ } else {
+ ui_msg "\nThe ports tree has been updated. To upgrade your installed ports, you should run"
+ ui_msg " port upgrade outdated"
+ }
+ }
+
+ return 0
+}
Modified: branches/vcs-fetch/base/src/macports1.0/tests/library.tcl
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/tests/library.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/tests/library.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -63,3 +63,26 @@
# We don't need to handle portinterp_deferred_options, they're
# automatically handled correctly.
}
+
+# Set up a custom environment with its own configuration
+proc init_tmp_prefix {srcpath dstpath} {
+ global env
+
+ # use custom macports.conf and sources.conf
+ makeDirectory $dstpath
+ makeDirectory $dstpath/share
+ makeDirectory $dstpath/var/macports/registry
+ makeDirectory $dstpath/var/macports/distfiles
+ set fd [open $dstpath/macports.conf w+]
+ puts $fd "portdbpath $dstpath/var/macports"
+ puts $fd "prefix $dstpath"
+ puts $fd "variants_conf $dstpath/variants.conf"
+ puts $fd "sources_conf $srcpath/sources.conf"
+ puts $fd "applications_dir $dstpath/Applications"
+ puts $fd "frameworks_dir $dstpath/Library/Frameworks"
+ close $fd
+ file link -symbolic $dstpath/share/macports $macports::autoconf::prefix/share/macports
+ close [open $dstpath/variants.conf w+]
+
+ set env(PORTSRC) $dstpath/macports.conf
+}
Modified: branches/vcs-fetch/base/src/macports1.0/tests/macports.test
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/tests/macports.test 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/tests/macports.test 2016-03-23 23:51:56 UTC (rev 147031)
@@ -12,36 +12,21 @@
testConstraint darwin [expr {$macports::autoconf::os_platform eq "darwin"}]
package require macports 1.0
+package require Thread
+source ./library.tcl
+
# clean leftovers from interrupted tests
file delete -force $pwd/tmpdir
+# use a local, temporary prefix for testing
+init_tmp_prefix $pwd $pwd/tmpdir
-# use custom macports.conf and sources.conf
-makeDirectory $pwd/tmpdir
-makeDirectory $pwd/tmpdir/share
-makeDirectory $pwd/tmpdir/var/macports/registry
-set fd [open $pwd/tmpdir/macports.conf w+]
-puts $fd "portdbpath $pwd/tmpdir/var/macports"
-puts $fd "prefix $pwd/tmpdir"
-puts $fd "variants_conf $pwd/tmpdir/variants.conf"
-puts $fd "sources_conf $pwd/sources.conf"
-puts $fd "applications_dir $pwd/tmpdir/Applications"
-puts $fd "frameworks_dir $pwd/tmpdir/Library/Frameworks"
-close $fd
-set env(PORTSRC) $pwd/tmpdir/macports.conf
-file link -symbolic $pwd/tmpdir/share/macports $macports::autoconf::prefix/share/macports
-close [open $pwd/tmpdir/variants.conf w+]
-
# Debug options
array set ui_options {}
-#set ui_options(ports_debug) yes
-#set ui_options(ports_verbose) yes
+set ui_options(ports_noninteractive) yes
mportinit ui_options
-package require Thread
-source ./library.tcl
-
test mportclose {
Mport close unit test.
} -setup {
@@ -112,13 +97,6 @@
if {[macports::init_logging $mport] != 0} {
return "FAIL: incorrect channels"
}
- if {$macports::channels(any) ne "stdout debuglog"} {
- return "FAIL: incorrect channels(any)"
- }
- if {(![info exists ui_options(ports_debug)] && $macports::channels(debug) ne "debuglog") ||
- ([info exists ui_options(ports_debug)] && $macports::channels(debug) ne "stderr debuglog")} {
- return "FAIL: incorrect channels(debug)"
- }
return "Init logging successful."
} -cleanup {
mportclose $mport
@@ -351,12 +329,19 @@
test ui_warn_once {
UI warn once unit test.
+} -setup {
+ # suppress test warning to avoid noise on terminal output
+ set channel_saved $macports::channels(warn)
+ set macports::channels(warn) {}
} -body {
set res [ui_warn_once 0 test]
+
if {$macports::warning_done(0) != 1} {
return "FAIL: warning flag not set"
}
return "UI warn once successful."
+} -cleanup {
+ set macports::channels(warn) $channel_saved
} -result "UI warn once successful."
Modified: branches/vcs-fetch/base/src/macports1.0/tests/reclaim.test
===================================================================
--- branches/vcs-fetch/base/src/macports1.0/tests/reclaim.test 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/macports1.0/tests/reclaim.test 2016-03-23 23:51:56 UTC (rev 147031)
@@ -9,22 +9,24 @@
source ../macports_test_autoconf.tcl
package require macports 1.0
+source ./library.tcl
+
+# clean leftovers from interrupted tests
+file delete -force $pwd/tmpdir
+# use a local, temporary prefix for testing
+init_tmp_prefix $pwd $pwd/tmpdir
+
array set ui_options {}
+set ui_options(ports_noninteractive) yes
mportinit ui_options
+# reclaim nees to be fixed to honor the noninteractive flag
test remove_distfiles {
-
- # Regression test for remove_distfiles.
- #
- # Constraints:
- # Requires root to run.
-
Test for distfiles being successfully removed.
-
} -constraints {
root
+ userInteraction
} -body {
-
set path [file join ${macports::portdbpath} distfiles]
set file [file join $path "test.txt"]
@@ -38,26 +40,15 @@
}
return "Successfully removed distfile."
-
} -cleanup {
file delete -force $file
-
} -result "Successfully removed distfile."
test update_last_run {
-
- # Regression test for update_last_run.
- #
- # Constraints:
- # Requires root to run.
-
Tests for last_reclaim file being updated.
-
} -constraints {
root
-
} -body {
-
set path [file join ${macports::portdbpath} last_reclaim]
set fd [open $path w]
@@ -83,24 +74,14 @@
set fd [open $path w]
puts $fd $old_time
close $fd
-
} -result "Successfully updated to the correct time."
test walk_files {
-
- # Regression test for walk_files.
- #
- # Constraints:
- # Require's root to run.
-
Tests if walking through the files, and deleting distfiles, ignoring normal files, and removing directory trees works.
-
} -constraints {
root
-
} -body {
-
set path [file join ${macports::portdbpath} distfiles]
set dir [file join $path tmp_dir]
set subdir [file join $dir other_tmp_dir]
@@ -108,6 +89,7 @@
set bad_dist2 [file join $dir bad_distfile2.txt]
set good_dist [file join $dir good_distfile.txt]
set dist_list [list]
+ set unused_list [list]
lappend dist_list $good_dist
@@ -122,18 +104,24 @@
set $fd [open $good_dist w]
close $fd
- reclaim::walk_files $dir yes $dist_list
+ reclaim::walk_files $dir $dist_list unused_list
- if {[file exists $bad_dist] || [file exists $bad_dist2] || [file exists $subdir] || ![file exists $good_dist] || ![file exists $dir]} {
- return "FAIL: Did not delete the correct files, or deleted files that should not have been deleted."
+ if {[lsearch -exact $unused_list $bad_dist] == -1} {
+ return "FAIL: bad_dist should be deleted"
}
+ if {[lsearch -exact $unused_list $bad_dist2] == -1} {
+ return "FAIL: bad_dist2 should be deleted"
+ }
+ if {[lsearch -exact $unused_list $good_dist] != -1} {
+ return "FAIL: good_dist should NOT be deleted"
+ }
+ if {[lsearch -exact $unused_list $dir] != -1} {
+ return "FAIL: good_dist should NOT be deleted"
+ }
return "Successfully deleted all files that needed to be deleted."
-
} -cleanup {
file delete -force $dir
-
} -result "Successfully deleted all files that needed to be deleted."
cleanupTests
-
Modified: branches/vcs-fetch/base/src/port/port.tcl
===================================================================
--- branches/vcs-fetch/base/src/port/port.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port/port.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -18,7 +18,7 @@
# 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
@@ -115,12 +115,12 @@
Portnames that contain standard glob characters will be expanded to the
set of ports matching the glob pattern.
-
+
Port expressions
----------------
Portnames, port glob patterns, and pseudo-portnames may be logically
combined using expressions consisting of and, or, not, !, (, and ).
-
+
For more information
--------------------
See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
@@ -154,58 +154,6 @@
proc $name {} [list return [expr $args]]
}
-# Format an integer representing bytes using given units
-proc bytesize {siz {unit {}} {format {%.3f}}} {
- if {$unit == {}} {
- if {$siz > 0x40000000} {
- set unit "GiB"
- } elseif {$siz > 0x100000} {
- set unit "MiB"
- } elseif {$siz > 0x400} {
- set unit "KiB"
- } else {
- set unit "B"
- }
- }
- switch -- $unit {
- KiB {
- set siz [expr {$siz / 1024.0}]
- }
- kB {
- set siz [expr {$siz / 1000.0}]
- }
- MiB {
- set siz [expr {$siz / 1048576.0}]
- }
- MB {
- set siz [expr {$siz / 1000000.0}]
- }
- GiB {
- set siz [expr {$siz / 1073741824.0}]
- }
- GB {
- set siz [expr {$siz / 1000000000.0}]
- }
- B { }
- default {
- ui_warn "Unknown file size unit '$unit' specified"
- set unit "B"
- }
- }
- if {[expr {round($siz)}] != $siz} {
- set siz [format $format $siz]
- }
- return "$siz $unit"
-}
-
-proc filesize {fil {unit {}}} {
- set siz {@}
- catch {
- set siz [bytesize [file size $fil] $unit]
- }
- return $siz
-}
-
# Produce an error message, and exit, unless
# we're handling errors in a soft fashion, in which
# case we continue
@@ -223,7 +171,7 @@
# we're handling errors in a soft fashion, in which
# case we continue
proc break_softcontinue { msg status name_status } {
- upvar $name_status status_var
+ upvar $name_status status_var
ui_error $msg
if {[macports::ui_isset ports_processall]} {
set status_var 0
@@ -245,7 +193,7 @@
# This function sorts the variants and presents them in a canonical representation
proc composite_version {version variations {emptyVersionOkay 0}} {
# Form a composite version out of the version and variations
-
+
# Select the variations into positive and negative
set pos {}
set neg {}
@@ -367,14 +315,14 @@
# Form the fully discriminated portname: portname/version_revison+-variants
set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
-
+
return [array get port]
}
proc add_to_portlist {listname portentry} {
upvar $listname portlist
-
+
# Form portlist entry and add to portlist
lappend portlist [entry_for_portlist $portentry]
}
@@ -455,7 +403,7 @@
proc foreachport {portlist block} {
set savedir [pwd]
foreach portspec $portlist {
-
+
# Set the variables for the block
uplevel 1 "array unset portspec; array set portspec { $portspec }"
uplevel 1 {
@@ -469,10 +417,10 @@
array unset options
array set options $portspec(options)
}
-
+
# Invoke block
uplevel 1 $block
-
+
# Restore cwd after each port, since mportopen changes it, and otherwise relative
# urls would break on subsequent passes
if {[file exists $savedir]} {
@@ -686,7 +634,7 @@
foreach m $list {
if {[string first "@" $m] < 0} {
if {[string first ":" $m] >= 0} {
- set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
+ set m [regsub -- "(.*):(.*)" $m "\\2@\\1"]
} elseif {$m ne "openmaintainer" && $m ne "nomaintainer"} {
set m "$m at macports.org"
}
@@ -706,15 +654,15 @@
foreach {name info} $infos {
array unset portinfo
array set portinfo $info
-
+
set portentry [entry_for_portlist [list url $portinfo(porturl) name $name]]
-
+
array unset entry
array set entry $portentry
-
+
if {[info exists unique($entry(fullname))]} continue
set unique($entry(fullname)) 1
-
+
lappend result $portentry
}
return $result
@@ -728,7 +676,7 @@
fatal "search for portname $pattern failed: $result"
}
set results [unique_results_to_portlist $res]
-
+
# Return the list of all ports, sorted
return [portlist_sort $results]
}
@@ -891,12 +839,12 @@
# Get information about latest available version and revision
set latest_version $portinfo(version)
set latest_revision 0
- if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
set latest_revision $portinfo(revision)
}
set latest_compound "${latest_version}_${latest_revision}"
set latest_epoch 0
- if {[info exists portinfo(epoch)]} {
+ if {[info exists portinfo(epoch)]} {
set latest_epoch $portinfo(epoch)
}
@@ -1108,7 +1056,7 @@
array unset portinfo
array set portinfo [lindex $result 1]
set porturl $portinfo(porturl)
-
+
# open its portfile
if {[catch {set mport [mportopen $porturl [list subport $portinfo(name)] [array get global_variations]]} result]} {
ui_debug "$::errorInfo"
@@ -1198,7 +1146,7 @@
proc seqExpr { resname } {
upvar $resname reslist
-
+
# Evaluate a sequence of expressions a b c...
# These act the same as a or b or c
@@ -1217,14 +1165,14 @@
set reslist [opUnion $reslist $blist]
}
}
-
+
return $result
}
proc orExpr { resname } {
upvar $resname reslist
-
+
set a [andExpr reslist]
while ($a) {
switch -- [lookahead] {
@@ -1234,7 +1182,7 @@
if {![andExpr blist]} {
return 0
}
-
+
# Calculate a union b
set reslist [opUnion $reslist $blist]
}
@@ -1243,26 +1191,26 @@
}
}
}
-
+
return $a
}
proc andExpr { resname } {
upvar $resname reslist
-
+
set a [unaryExpr reslist]
while {$a} {
switch -- [lookahead] {
and {
advance
-
+
set blist {}
set b [unaryExpr blist]
if {!$b} {
return 0
}
-
+
# Calculate a intersect b
set reslist [opIntersection $reslist $blist]
}
@@ -1271,7 +1219,7 @@
}
}
}
-
+
return $a
}
@@ -1295,7 +1243,7 @@
set result [element reslist]
}
}
-
+
return $result
}
@@ -1303,13 +1251,13 @@
proc element { resname } {
upvar $resname reslist
set el 0
-
+
set url ""
set name ""
set version ""
array unset requested_variants
array unset options
-
+
set token [lookahead]
switch -regex -- $token {
^\\)$ -
@@ -1411,10 +1359,10 @@
set recursive [string equal $selector "rdependentof"]
add_multiple_ports reslist [get_dependent_ports $portname $recursive]
-
+
set el 1
}
-
+
^depof: -
^rdepof: {
advance
@@ -1424,7 +1372,7 @@
set recursive [string equal $selector "rdepof"]
add_multiple_ports reslist [get_dep_ports $portname $recursive]
-
+
set el 1
}
@@ -1481,12 +1429,12 @@
proc add_multiple_ports { resname ports {remainder ""} } {
upvar $resname reslist
-
+
set version ""
array unset variants
array unset options
parsePortSpec version variants options $remainder
-
+
array unset overrides
if {$version ne ""} { set overrides(version) $version }
if {[array size variants]} {
@@ -1525,7 +1473,7 @@
proc opIntersection { a b } {
set result {}
-
+
# Rules we follow in performing the intersection of two port lists:
#
# a/, a/ ==> a/
@@ -1536,7 +1484,7 @@
#
# If there's an exact match, we take it.
# If there's a match between simple and discriminated, we take the later.
-
+
# First create a list of the fully discriminated names in b
array unset bfull
set i 0
@@ -1545,14 +1493,14 @@
set bfull($port(fullname)) $i
incr i
}
-
+
# Walk through each item in a, matching against b
foreach aitem [unique_entries $a] {
array set port $aitem
-
+
# Quote the fullname and portname to avoid special characters messing up the regexp
set safefullname [regex_pat_sanitize $port(fullname)]
-
+
set simpleform [expr { "$port(name)/" == $port(fullname) }]
if {$simpleform} {
set pat "^${safefullname}"
@@ -1560,7 +1508,7 @@
set safename [regex_pat_sanitize $port(name)]
set pat "^${safefullname}$|^${safename}/$"
}
-
+
set matches [array names bfull -regexp $pat]
foreach match $matches {
if {$simpleform} {
@@ -1571,16 +1519,16 @@
}
}
}
-
+
return $result
}
proc opComplement { a b } {
set result {}
-
+
# Return all elements of a not matching elements in b
-
+
# First create a list of the fully discriminated names in b
array unset bfull
set i 0
@@ -1589,14 +1537,14 @@
set bfull($port(fullname)) $i
incr i
}
-
+
# Walk through each item in a, taking all those items that don't match b
foreach aitem $a {
array set port $aitem
-
+
# Quote the fullname and portname to avoid special characters messing up the regexp
set safefullname [regex_pat_sanitize $port(fullname)]
-
+
set simpleform [expr { "$port(name)/" == $port(fullname) }]
if {$simpleform} {
set pat "^${safefullname}"
@@ -1604,7 +1552,7 @@
set safename [regex_pat_sanitize $port(name)]
set pat "^${safefullname}$|^${safename}/$"
}
-
+
set matches [array names bfull -regexp $pat]
# We copy this element to result only if it didn't match against b
@@ -1612,7 +1560,7 @@
lappend result $aitem
}
}
-
+
return $result
}
@@ -1623,12 +1571,12 @@
upvar $vername portversion
upvar $varname portvariants
upvar $optname portoptions
-
+
set portname ""
set portversion ""
array unset portvariants
array unset portoptions
-
+
if { [moreargs] } {
# Look first for a potential portname
#
@@ -1641,7 +1589,7 @@
if {|[[:alpha:]_]+[\w\.]*=)} $token match]} {
advance
regexp {^([^@]+)(@.*)?} $token match portname remainder
-
+
# If the portname contains a /, then try to use it as a URL
if {[string match "*/*" $portname]} {
set url "file://$portname"
@@ -1662,7 +1610,7 @@
}
}
}
-
+
# Now parse the rest of the spec
parsePortSpec portversion portvariants portoptions $remainder
}
@@ -1680,25 +1628,25 @@
}
}
-
+
proc parsePortSpec { vername varname optname {remainder ""} } {
upvar $vername portversion
upvar $varname portvariants
upvar $optname portoptions
-
+
global global_options
-
+
set portversion ""
array unset portoptions
array set portoptions [array get global_options]
array unset portvariants
-
+
# Parse port version/variants/options
set opt $remainder
set adv 0
set consumed 0
for {set firstTime 1} {$opt ne "" || [moreargs]} {set firstTime 0} {
-
+
# Refresh opt as needed
if {$opt eq ""} {
if {$adv} advance
@@ -1706,14 +1654,14 @@
set adv 1
set consumed 0
}
-
+
# Version must be first, if it's there at all
if {$firstTime && [string match {@*} $opt]} {
# Parse the version
-
+
# Strip the @
set opt [string range $opt 1 end]
-
+
# Handle the version
set sepPos [string first "/" $opt]
if {$sepPos >= 0} {
@@ -1736,7 +1684,7 @@
set consumed 1
} else {
# Parse all other options
-
+
# Look first for a variable setting: VARNAME=VALUE
if {[regexp {^([[:alpha:]_]+[\w\.]*)=(.*)} $opt match key val] == 1} {
# It's a variable setting
@@ -2018,10 +1966,10 @@
# specified for the port (so we get e.g. dependencies right)
array unset merged_variations
array set merged_variations [array get variations]
- foreach { variation value } [array get global_variations] {
- if { ![info exists merged_variations($variation)] } {
- set merged_variations($variation) $value
- }
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
}
if {![info exists options(subport)]} {
if {[info exists portinfo(name)]} {
@@ -2030,7 +1978,7 @@
set options(subport) $portname
}
}
-
+
if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
ui_debug "$::errorInfo"
break_softcontinue "Unable to open port: $result" 1 status
@@ -2122,13 +2070,13 @@
set options(ports_info_depends_run) yes
set options(ports_info_depends_test) yes
}
-
+
# Set up our field separators
set show_label 1
set field_sep "\n"
set subfield_sep ", "
set pretty_print 0
-
+
# For human-readable summary, which is the default with no options
if {[llength [array get options ports_info_*]] == 0} {
set pretty_print 1
@@ -2145,7 +2093,7 @@
set field_sep "\t"
set subfield_sep ","
}
-
+
# Figure out whether to show field name
set quiet [macports::ui_isset ports_quiet]
if {$quiet} {
@@ -2165,9 +2113,9 @@
set opts_todo {ports_info_heading
ports_info_replaced_by
ports_info_subports
- ports_info_variants
+ ports_info_variants
ports_info_skip_line
- ports_info_long_description ports_info_homepage
+ ports_info_long_description ports_info_homepage
ports_info_skip_line ports_info_depends_fetch
ports_info_depends_extract ports_info_depends_build
ports_info_depends_lib ports_info_depends_run
@@ -2201,7 +2149,7 @@
} else {
# Map from friendly name
set ropt [map_friendly_field_names $opt]
-
+
# If there's no such info, move on
if {![info exists portinfo($ropt)]} {
set inf ""
@@ -2221,7 +2169,7 @@
} elseif {$show_label} {
set label "$opt: "
}
-
+
# Format the data
if { $ropt eq "maintainers" } {
set inf [unobscure_maintainers $inf]
@@ -2257,7 +2205,7 @@
}
lappend inf "$varmodifier$v"
}
- } elseif {[string match "depend*" $ropt]
+ } elseif {[string match "depend*" $ropt]
&& ![macports::ui_isset ports_verbose]} {
set pi_deps $inf
set inf {}
@@ -2265,14 +2213,14 @@
lappend inf [lindex [split $d :] end]
}
}
- }
+ }
#End of special pretty-print formatting for certain fields
if {[info exists list_map($ropt)]} {
set field [join $inf $subfield_sep]
} else {
set field $inf
}
-
+
# Assemble the entry
if {$pretty_print} {
# The two special fields are considered headings and are
@@ -2320,7 +2268,7 @@
set separator "--\n"
}
}
-
+
return $status
}
@@ -2349,7 +2297,7 @@
ui_notice "Port $portname ${version}_${revision}${variants} is installed as an image in:"
puts $imagedir
}
-
+
return $status
}
@@ -2377,15 +2325,15 @@
array set portinfo [lindex $result 1]
set porturl $portinfo(porturl)
}
-
+
# Add any global_variations to the variations
# specified for the port
array unset merged_variations
array set merged_variations [array get variations]
- foreach { variation value } [array get global_variations] {
- if { ![info exists merged_variations($variation)] } {
- set merged_variations($variation) $value
- }
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
}
if {![info exists options(subport)]} {
if {[info exists portinfo(name)]} {
@@ -2457,7 +2405,7 @@
}
}
registry::close_file_map
-
+
return 0
}
@@ -2489,7 +2437,7 @@
ui_msg "Skipping activate $portname (dry run)"
}
}
-
+
return $status
}
@@ -2526,7 +2474,7 @@
ui_msg "Skipping deactivate $portname (dry run)"
}
}
-
+
return $status
}
@@ -2548,7 +2496,7 @@
}
set group [lindex $portlist 0]
-
+
# If no command (--set, --show, --list, --summary) is specified *but*
# more than one argument is specified, default to the set command.
if {[llength $commands] < 1 && [llength $portlist] > 1} {
@@ -2710,7 +2658,7 @@
}
fatal "port selfupdate failed: $result"
}
-
+
if {$base_updated} {
# exit immediately if in batch/interactive mode
return -999
@@ -2741,7 +2689,7 @@
break_softcontinue "$result" 1 status
}
}
-
+
return $status
}
@@ -2757,7 +2705,7 @@
if {[prefix_unwritable]} {
return 1
}
- macports::reclaim_main
+ macports::reclaim_main
return 0
}
@@ -2780,7 +2728,7 @@
}
}
}
-
+
if {$status != 0 && $status != 2 && $status != 3} {
print_tickets_url
} elseif {$status == 0} {
@@ -2857,7 +2805,7 @@
set irevision [lindex $ilist $index 2]
set ivariants [lindex $ilist $index 3]
}
-
+
set deplist [registry::list_dependents $portname $iversion $irevision $ivariants]
if { [llength $deplist] > 0 } {
if {$action eq "rdependents"} {
@@ -2993,10 +2941,10 @@
# specified for the port, so we get dependencies right
array unset merged_variations
array set merged_variations [array get variations]
- foreach { variation value } [array get global_variations] {
- if { ![info exists merged_variations($variation)] } {
- set merged_variations($variation) $value
- }
+ foreach { variation value } [array get global_variations] {
+ if { ![info exists merged_variations($variation)] } {
+ set merged_variations($variation) $value
+ }
}
if {![info exists options(subport)]} {
if {[info exists portinfo(name)]} {
@@ -3071,7 +3019,7 @@
set depname [lindex [split $dep :] end]
if {![info exists seen($depname)]} {
set seen($depname) 1
-
+
# look up the dep
if {[catch {mportlookup $depname} result]} {
ui_debug "$::errorInfo"
@@ -3084,7 +3032,7 @@
array set portinfo [lindex $result 1]
set porturl $portinfo(porturl)
set options(subport) $portinfo(name)
-
+
# open the portfile if requested
if {!([info exists options(ports_${action}_index)] && $options(ports_${action}_index) eq "yes")} {
if {[catch {set mport [mportopen $porturl [array get options] [array get merged_variations]]} result]} {
@@ -3095,7 +3043,7 @@
array set portinfo [mportinfo $mport]
mportclose $mport
}
-
+
# get list of the dep's deps
set rdeplist {}
foreach type $deptypes {
@@ -3222,7 +3170,7 @@
set status 0
set restrictedList 0
set ilist {}
-
+
if { [llength $portlist] || (![info exists private_options(ports_no_args)] || $private_options(ports_no_args) eq "no")} {
set restrictedList 1
foreachport $portlist {
@@ -3270,6 +3218,10 @@
if {$archs != 0 && $archs ne ""} {
append extra " archs='$archs'"
}
+ set date [registry::property_retrieve $regref date]
+ if {$date ne ""} {
+ append extra " date='[clock format $date -format "%Y-%m-%d %T"]'"
+ }
}
if { $iactive == 0 } {
puts " $iname @${iversion}_${irevision}${ivariants}${nvariants}${extra}"
@@ -3322,7 +3274,7 @@
set num_outdated 0
if { [llength $ilist] > 0 } {
foreach i [portlist_sortint $ilist] {
-
+
# Get information about the installed port
set portname [lindex $i 0]
set installed_version [lindex $i 1]
@@ -3349,7 +3301,7 @@
}
array unset portinfo
array set portinfo [lindex $res 1]
-
+
# Get information about latest available version and revision
if {![info exists portinfo(version)]} {
ui_warn "$portname has no version field"
@@ -3357,15 +3309,15 @@
}
set latest_version $portinfo(version)
set latest_revision 0
- if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
+ if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
set latest_revision $portinfo(revision)
}
set latest_compound "${latest_version}_${latest_revision}"
set latest_epoch 0
- if {[info exists portinfo(epoch)]} {
+ if {[info exists portinfo(epoch)]} {
set latest_epoch $portinfo(epoch)
}
-
+
# Compare versions, first checking epoch, then version, then revision
set epoch_comp_result [expr {$installed_epoch - $latest_epoch}]
set comp_result [vercmp $installed_version $latest_version]
@@ -3389,10 +3341,10 @@
set reason { (platform $os_platform_installed $os_major_installed != ${macports::os_platform} ${macports::os_major})}
}
}
-
+
# Report outdated (or, for verbose, predated) versions
if { $comp_result != 0 } {
-
+
# Form a relation between the versions
set flag ""
if { $comp_result > 0 } {
@@ -3401,10 +3353,10 @@
} else {
set relation "<"
}
-
+
# Emit information
if {$comp_result < 0 || [macports::ui_isset ports_verbose]} {
-
+
if {$num_outdated == 0} {
ui_notice "The following installed ports are outdated:"
}
@@ -3412,10 +3364,10 @@
puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound [subst $reason]" $flag]
}
-
+
}
}
-
+
if {$num_outdated == 0} {
ui_notice "No installed ports are outdated."
}
@@ -3424,7 +3376,7 @@
} else {
ui_notice "No ports are installed."
}
-
+
return $status
}
@@ -3805,12 +3757,12 @@
proc action_list { action portlist opts } {
global private_options
set status 0
-
+
# Default to list all ports if no portnames are supplied
if { ![llength $portlist] && [info exists private_options(ports_no_args)] && $private_options(ports_no_args) eq "yes"} {
add_to_portlist portlist [list name "-all-"]
}
-
+
foreachport $portlist {
if {$portname eq "-all-"} {
if {[catch {set res [mportlistall]} result]} {
@@ -3841,7 +3793,7 @@
puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
}
}
-
+
return $status
}
@@ -3880,7 +3832,7 @@
global env boot_env current_portdir
array set local_options $opts
-
+
set status 0
if {[require_portlist portlist]} {
return 1
@@ -3889,7 +3841,7 @@
array unset portinfo
# If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
if {$porturl eq ""} {
-
+
# Verify the portname, getting portinfo to map to a porturl
if {[catch {set res [mportlookup $portname]} result]} {
global errorInfo
@@ -3903,13 +3855,13 @@
set porturl $portinfo(porturl)
set portname $portinfo(name)
}
-
-
+
+
# Calculate portdir, porturl, and portfile from initial porturl
set portdir [file normalize [macports::getportdir $porturl]]
set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
set portfile "${portdir}/Portfile"
-
+
# Now execute the specific action
if {[file readable $portfile]} {
switch -- $action {
@@ -3921,17 +3873,17 @@
}
close $f
}
-
+
edit {
# Edit the port's portfile with the user's editor
-
+
# Restore our entire environment from start time.
# We need it to evaluate the editor, and the editor
# may want stuff from it as well, like TERM.
array unset env_save; array set env_save [array get env]
array unset env *
array set env [array get boot_env]
-
+
# Find an editor to edit the portfile
set editor ""
set editor_var "ports_${action}_editor"
@@ -3945,17 +3897,17 @@
}
}
}
-
+
# Use a reasonable canned default if no editor specified or set in env
if { $editor eq "" } { set editor "/usr/bin/vi" }
-
+
# Invoke the editor
if {[catch {exec -ignorestderr >@stdout <@stdin {*}$editor $portfile} result]} {
global errorInfo
ui_debug "$errorInfo"
break_softcontinue "unable to invoke editor $editor: $result" 1 status
}
-
+
# Restore internal MacPorts environment
array unset env *
array set env [array get env_save]
@@ -4032,7 +3984,7 @@
break_softcontinue "Could not read $portfile" 1 status
}
}
-
+
return $status
}
@@ -4047,7 +3999,7 @@
ui_msg "port sync failed: $result"
set status 1
}
-
+
return $status
}
@@ -4136,14 +4088,14 @@
}
mportclose $workername
-
+
# Process any error that wasn't thrown and handled already
if {$result} {
print_tickets_url
break_softcontinue "Processing of port $portname failed" 1 status
}
}
-
+
if {$status == 0 && $action eq "install" && ![macports::global_option_isset ports_dryrun]} {
array set options $opts
if {![info exists options(ports_nodeps)] && ![info exists options(ports_install_no-rev-upgrade)] && ${macports::revupgrade_autorun}} {
@@ -4316,7 +4268,7 @@
# Returns an action proc, or a list of matching action procs, or the action passed in
proc find_action { action } {
global action_array
-
+
if { ! [info exists action_array($action)] } {
set guess [guess_action $action]
if { [info exists action_array($guess)] } {
@@ -4324,7 +4276,7 @@
}
return $guess
}
-
+
return $action
}
@@ -4332,7 +4284,7 @@
# If there's more than one match, return the next possibility
proc find_action_proc { action } {
global action_array
-
+
set action_proc ""
if { [info exists action_array($action)] } {
set action_proc [lindex $action_array($action) 0]
@@ -4342,18 +4294,18 @@
set action_proc [lindex $action_array($action) 0]
}
}
-
+
return $action_proc
}
proc get_action_proc { action } {
global action_array
-
+
set action_proc ""
if { [info exists action_array($action)] } {
set action_proc [lindex $action_array($action) 0]
}
-
+
return $action_proc
}
@@ -4464,10 +4416,10 @@
upvar $ui_options_name ui_options
upvar $global_options_name global_options
global cmdname cmd_opts_array
-
+
while {[moreargs]} {
set arg [lookahead]
-
+
if {[string index $arg 0] ne "-"} {
break
} elseif {[string index $arg 1] eq "-"} {
@@ -4528,7 +4480,7 @@
# Ignore errors while processing within a command
set ui_options(ports_processall) yes
}
- N {
+ N {
# Interactive mode is available or not
set ui_options(ports_noninteractive) yes
}
@@ -4623,26 +4575,34 @@
while {($action_status == 0 || [macports::ui_isset ports_processall]) && [moreargs]} {
set action [lookahead]
advance
-
+
# Handle command separator
if { $action == ";" } {
continue
}
-
+
# Handle a comment
if { [string index $action 0] == "#" } {
while { [moreargs] } { advance }
break
}
- set locked [lock_reg_if_needed $action]
+ try {
+ set locked [lock_reg_if_needed $action]
+ } catch {{POSIX SIG SIGINT} eCode eMessage} {
+ set action_status 1
+ break
+ } catch {{POSIX SIG SIGTERM} eCode eMessage} {
+ set action_status 1
+ break
+ }
# Always start out processing an action in current_portdir
cd $current_portdir
-
+
# Reset global_options from base before each action, as we munge it just below...
array unset global_options
array set global_options $global_options_base
-
+
# Find an action to execute
set actions [find_action $action]
if {[llength $actions] == 1} {
@@ -4711,7 +4671,7 @@
}
}
}
-
+
# execute the action
set action_status [$action_proc $action $portlist [array get global_options]]
@@ -4726,14 +4686,14 @@
# semaphore to exit
if {$action_status == -999} break
}
-
+
return $action_status
}
-proc complete_portname { text state } {
+proc complete_portname { text state } {
global complete_choices complete_position
-
+
if {$state == 0} {
set complete_position 0
set complete_choices {}
@@ -4748,16 +4708,16 @@
lappend complete_choices $name
}
}
-
+
set word [lindex $complete_choices $complete_position]
incr complete_position
-
+
return $word
}
# return text action beginning with $text
-proc complete_action { text state } {
+proc complete_action { text state } {
global action_array complete_choices complete_position
if {$state == 0} {
@@ -4772,7 +4732,7 @@
}
# return all actions beginning with $text
-proc guess_action { text } {
+proc guess_action { text } {
global action_array
return [array names action_array "[string tolower $text]*"]
@@ -4793,14 +4753,14 @@
# Decide how to do completion based on where we are in the string
set prefix [string range $text 0 [expr {$start - 1}]]
-
+
# If only whitespace characters preceed us, or if the
# previous non-whitespace character was a ;, then we're
# an action (the first word of a command)
if { [regexp {(^\s*$)|(;\s*$)} $prefix] } {
return complete_action
}
-
+
# Otherwise, do completion on portname
return complete_portname
}
@@ -4808,7 +4768,7 @@
proc get_next_cmdline { in out use_readline prompt linename } {
upvar $linename line
-
+
set line ""
while { $line eq "" } {
@@ -4823,14 +4783,14 @@
if { $len < 0 } {
return -1
}
-
+
set line [string trim $line]
if { $use_readline && $line ne "" } {
rl_history add $line
}
}
-
+
return [llength $line]
}
@@ -4877,7 +4837,7 @@
# Process the command
set exit_status [process_cmd $line]
-
+
# Check for semaphore to exit
if {$exit_status == -999} {
set exit_status 0
@@ -5322,203 +5282,320 @@
# Create namespace for questions
namespace eval portclient::questions {
-
- package require Tclx
- ##
- # Function that handles printing of a timeout.
- #
- # @param time
- # The amount of time for which a timeout is to occur.
- # @param def
- # The default action to be taken in the occurence of a timeout.
- proc ui_timeout {def timeout} {
- fconfigure stdin -blocking 0
- signal error {TERM INT}
- while {$timeout >= 0} {
- if {[catch {set inp [read stdin]} err]} {
- return -code error "Ctrl-C"
- }
- if {$inp eq "\n"} {
- return $def
- }
- puts -nonewline "\r"
- puts -nonewline [format "Continuing in %02d s. Press Ctrl-C to exit: " $timeout]
- flush stdout
- after 1000
- incr timeout -1
- }
- puts ""
- fconfigure stdin -blocking 1
- signal -restart error {TERM INT}
- return $def
- }
-
- ##
- # Main function that displays numbered choices for a multiple choice question.
- #
- # @param msg
- # The question specific message that is to be printed before asking the question.
- # @param ???name???
- # May be a qid will be of better use instead as the client does not do anything port specific.
- # @param ports
- # The list of ports for which the question is being asked.
- proc ui_choice {msg name ports} {
- # Print the main message
- puts $msg
-
- # Print portname or port list suitably
- set i 1
- foreach port $ports {
- puts -nonewline " $i) "
- puts [string map {@ " @" ( " ("} $port]
- incr i
- }
- }
-
- ##
- # Displays a question with 'yes' and 'no' as options.
- # Waits for user input indefinitely unless a timeout is specified.
- # Shows the list of port passed to it without any numbers.
- #
- # @param msg
- # The question specific message that is to be printed before asking the question.
- # @param ???name???
- # May be a qid will be of better use instead as the client does not do anything port specific.
- # @param ports
- # The port/list of ports for which the question is being asked.
- # @param def
- # The default answer to the question.
- # @param time
- # The amount of time for which a timeout is to occur.
- proc ui_ask_yesno {msg name ports def {timeout 0}} {
- # Set number default to the given letter default
- if {$def == {y}} {
- set default 0
- } else {
- set default 1
- }
-
- puts -nonewline $msg
- set leftmargin " "
-
- # Print portname or port list suitably
- if {[llength $ports] == 1} {
- puts -nonewline " "
- puts [string map {@ " @"} $ports]
- } else {
- puts ""
- foreach port $ports {
- puts -nonewline $leftmargin
- puts [string map {@ " @"} $port]
- }
- }
-
- # Check if timeout is set or not
- if {$timeout > 0} {
- # Run ui_timeout and skip the rest of the stuff here
- return [ui_timeout $default $timeout]
- }
-
- # Check for the default and print accordingly
- if {$def == {y}} {
- puts -nonewline "Continue? \[Y/n\]: "
- flush stdout
- } else {
- puts -nonewline "Continue? \[y/N\]: "
- flush stdout
- }
-
- # User input (probably requires some input error checking code)
- while 1 {
- signal error {TERM INT}
- if {[catch {set input [gets stdin]} err]} {
- return -code error "Ctrl-C"
- }
- signal -restart error {TERM INT}
- if {$input in {y Y}} {
- return 0
- } elseif {$input in {n N}} {
- return 1
- } elseif {$input == ""} {
- return $default
- } else {
- puts "Please enter either 'y' or 'n'."
- }
- }
- }
-
- ##
- # Displays a question with a list of numbered choices and asks the user to enter a number to specify their choice.
- # Waits for user input indefinitely.
- #
- # @param msg
- # The question specific message that is to be printed before asking the question.
- # @param ???name???
- # May be a qid will be of better use instead as the client does not do anything port specific.
- # @param ports
- # The port/list of ports for which the question is being asked.
- proc ui_ask_singlechoice {msg name ports} {
- ui_choice $msg $name $ports
-
- # User Input (single input restriction)
- while 1 {
- puts -nonewline "Enter a number to select an option: "
- flush stdout
- signal error {TERM INT}
- if {[catch {set input [gets stdin]} err]} {
- return -code error "Ctrl-C"
- }
- signal -restart error {TERM INT}
- if {($input <= [llength $ports] && [string is integer -strict $input])} {
- return $input
- } else {
- puts "Please enter an index from the above list."
- }
- }
- }
-
- ##
- # Displays a question with a list of numbered choices and asks the user to enter a space separated string of numbers to specify their choice.
- # Waits for user input indefinitely.
- #
- # @param msg
- # The question specific message that is to be printed before asking the question.
- # @param ???name???
- # May be a qid will be of better use instead as the client does not do anything port specific.
- # @param ports
- # The list of ports for which the question is being asked.
- proc ui_ask_multichoice {msg name ports} {
-
- ui_choice $msg $name $ports
-
- # User Input (with Multiple input parsing)
- while 1 {
- puts -nonewline "Enter the numbers to select the options: "
- flush stdout
- signal error {TERM INT}
- if {[catch {set input [gets stdin]} err]} {
- return -code error "Ctrl-C"
- }
- signal -restart error {TERM INT}
- set count 0
- # check if input is non-empty and otherwise fine
- if {$input == ""} {
- continue
- }
- foreach num $input {
- if {($num <= [llength $ports] && [string is integer -strict $num])} {
- incr count
- } else {
- puts "Please enter numbers separated by a space which are indices from the above list."
- break
- }
- }
- if {$count == [llength $input]} {
- return $input
- }
- }
- }
+ package require Tclx
+ ##
+ # Function that handles printing of a timeout.
+ #
+ # @param time
+ # The amount of time for which a timeout is to occur.
+ # @param def
+ # The default action to be taken in the occurence of a timeout.
+ proc ui_timeout {def timeout} {
+ fconfigure stdin -blocking 0
+
+ signal error {TERM INT}
+ while {$timeout >= 0} {
+ try {
+ set inp [read stdin]
+ } catch {*} {
+ # An error occurred, print a newline so the error message
+ # doesn't occur on the prompt line and re-throw
+ puts ""
+ throw
+ }
+ if {$inp eq "\n"} {
+ return $def
+ }
+ puts -nonewline "\r"
+ puts -nonewline [format "Continuing in %02d s. Press Ctrl-C to exit: " $timeout]
+ flush stdout
+ after 1000
+ incr timeout -1
+ }
+ puts ""
+ fconfigure stdin -blocking 1
+ signal -restart error {TERM INT}
+ return $def
+ }
+
+ ##
+ # Main function that displays numbered choices for a multiple choice question.
+ #
+ # @param msg
+ # The question specific message that is to be printed before asking the question.
+ # @param ???name???
+ # May be a qid will be of better use instead as the client does not do anything port specific.
+ # @param ports
+ # The list of ports for which the question is being asked.
+ proc ui_choice {msg name ports} {
+ # Print the main message
+ puts $msg
+
+ # Print portname or port list suitably
+ set i 1
+ foreach port $ports {
+ puts -nonewline " $i) "
+ puts [string map {@ " @" ( " ("} $port]
+ incr i
+ }
+ }
+
+ ##
+ # Displays a question with 'yes' and 'no' as options.
+ # Waits for user input indefinitely unless a timeout is specified.
+ # Shows the list of port passed to it without any numbers.
+ #
+ # @param msg
+ # The question specific message that is to be printed before asking the question.
+ # @param ???name???
+ # May be a qid will be of better use instead as the client does not do anything port specific.
+ # @param ports
+ # The port/list of ports for which the question is being asked.
+ # @param def
+ # The default answer to the question.
+ # @param timeout
+ # The amount of time for which a timeout is to occur.
+ # @param question
+ # Custom question message. Defaults to "Continue?".
+ proc ui_ask_yesno {msg name ports def {timeout 0} {question "Continue?"}} {
+ # Set number default to the given letter default
+ if {$def == {y}} {
+ set default 0
+ } else {
+ set default 1
+ }
+
+ puts -nonewline $msg
+ set leftmargin " "
+
+ # Print portname or port list suitably
+ if {[llength $ports] == 1} {
+ puts -nonewline " "
+ puts [string map {@ " @"} $ports]
+ } elseif {[llength $ports] == 0} {
+ puts -nonewline " "
+ } else {
+ puts ""
+ foreach port $ports {
+ puts -nonewline $leftmargin
+ puts [string map {@ " @"} $port]
+ }
+ }
+
+ # Check if timeout is set or not
+ if {$timeout > 0} {
+ # Run ui_timeout and skip the rest of the stuff here
+ return [ui_timeout $default $timeout]
+ }
+
+ # Check for the default and print accordingly
+ if {$def == {y}} {
+ puts -nonewline "${question} \[Y/n\]: "
+ flush stdout
+ } else {
+ puts -nonewline "${question} \[y/N\]: "
+ flush stdout
+ }
+
+ # User input (probably requires some input error checking code)
+ while 1 {
+ signal error {TERM INT}
+ try {
+ set input [gets stdin]
+ } catch {*} {
+ # An error occurred, print a newline so the error message
+ # doesn't occur on the prompt line and re-throw
+ puts ""
+ throw
+ }
+ signal -restart error {TERM INT}
+ if {$input in {y Y}} {
+ return 0
+ } elseif {$input in {n N}} {
+ return 1
+ } elseif {$input == ""} {
+ return $default
+ } else {
+ puts "Please enter either 'y' or 'n'."
+ }
+ }
+ }
+
+ ##
+ # Displays a question with a list of numbered choices and asks the user to enter a number to specify their choice.
+ # Waits for user input indefinitely.
+ #
+ # @param msg
+ # The question specific message that is to be printed before asking the question.
+ # @param ???name???
+ # May be a qid will be of better use instead as the client does not do anything port specific.
+ # @param ports
+ # The port/list of ports for which the question is being asked.
+ proc ui_ask_singlechoice {msg name ports} {
+ ui_choice $msg $name $ports
+
+ # User Input (single input restriction)
+ while 1 {
+ puts -nonewline "Enter a number to select an option: "
+ flush stdout
+ signal error {TERM INT}
+ try {
+ set input [gets stdin]
+ } catch {*} {
+ # An error occurred, print a newline so the error message
+ # doesn't occur on the prompt line and re-throw
+ puts ""
+ throw
+ }
+ signal -restart error {TERM INT}
+ if {($input <= [llength $ports] && [string is integer -strict $input])} {
+ return [expr {$input - 1}]
+ } else {
+ puts "Please enter an index from the above list."
+ }
+ }
+ }
+
+ ##
+ # Displays a question with a list of numbered choices and asks the user to enter a space separated string of numbers to specify their choice.
+ # Waits for user input indefinitely.
+ #
+ # @param msg
+ # The question specific message that is to be printed before asking the question.
+ # @param ???name???
+ # May be a qid will be of better use instead as the client does not do anything port specific.
+ # @param ports
+ # The list of ports for which the question is being asked.
+ proc ui_ask_multichoice {msg name ports} {
+
+ ui_choice $msg $name $ports
+
+ # User Input (with Multiple input parsing)
+ while 1 {
+ if {[llength $ports] > 1} {
+ set option_range "1-[llength $ports]"
+ } else {
+ set option_range "1"
+ }
+ puts -nonewline "Enter option(s) \[$option_range/all\]: "
+ flush stdout
+ signal error {TERM INT}
+ try {
+ set input [gets stdin]
+ } catch {*} {
+ # An error occurred, print a newline so the error message
+ # doesn't occur on the prompt line and re-throw
+ puts ""
+ throw
+ }
+ signal -restart error {TERM INT}
+ # check if input is non-empty and otherwise fine
+ if {$input == ""} {
+ return []
+ }
+
+ if {[string equal -nocase $input "all"]} {
+ set count 0
+ set options_seq []
+ foreach port $ports {
+ lappend options_seq $count
+ incr count
+ }
+ return $options_seq
+ }
+
+ if {[llength $input] > [llength $ports]} {
+ puts "Extra indices present. Please enter option(s) only once."
+ continue
+ }
+
+ set selected_opt []
+
+ set err_flag 1
+ foreach num $input {
+ if {[string is integer -strict $num] && $num <= [llength $ports] && $num > 0} {
+ lappend selected_opt [expr {$num -1}]
+ } elseif {[regexp {(\d+)-(\d+)} $input _ start end]
+ && $start <= [llength $ports]
+ && $start > 0
+ && $end <= [llength $ports]
+ && $end > 0
+ } then {
+ if {$start > $end} {
+ set tmp $start
+ set start $end
+ set end $tmp
+ }
+ for {set x $start} {$x <= $end} {incr x} {
+ lappend selected_opt [expr {$x -1}]
+ }
+ } else {
+ puts "Please enter numbers separated by a space which are indices from the above list."
+ set err_flag 0
+ break
+ }
+ }
+ if {$err_flag == 1} {
+ return $selected_opt
+ }
+ }
+ }
+
+ ##
+ # Displays alternative actions a user has to select by typing the text
+ # within the square brackets of the desired action name.
+ # Waits for user input indefinitely.
+ #
+ # @param msg
+ # The question specific message that is to be printed before asking the question.
+ # @param ???name???
+ # May be a qid will be of better use instead as the client does not do anything port specific.
+ # @param alts
+ # An array of action-text.
+ # @param def
+ # The default action. If empty, the first action is set as default
+ proc ui_ask_alternative {msg name alts def} {
+ puts $msg
+ upvar $alts alternatives
+
+ if {$def eq ""} {
+ # Default to first action
+ set def [lindex [array names alternatives] 0]
+ }
+
+ set alt_names []
+ foreach key [array names alternatives] {
+ set key_match [string first $key $alternatives($key)]
+ append alt_name [string range $alternatives($key) 0 [expr {$key_match - 1}]] \
+ \[ [expr {$def eq $key ? [string toupper $key] : $key}] \] \
+ [string range $alternatives($key) [expr {$key_match + [string length $key]}] end]
+ lappend alt_names $alt_name
+ unset alt_name
+ }
+
+ while 1 {
+ puts -nonewline "[join $alt_names /]: "
+ flush stdout
+ signal error {TERM INT}
+ try {
+ set input [gets stdin]
+ } catch {*} {
+ # An error occurred, print a newline so the error message
+ # doesn't occur on the prompt line and re-throw
+ puts ""
+ throw
+ }
+ set input [string tolower $input]
+ if {[info exists alternatives($input)]} {
+ return $input
+ } elseif {$input eq ""} {
+ return $def
+ } else {
+ puts "Please enter one of the alternatives"
+ }
+ }
+ }
}
##########################################
@@ -5576,12 +5653,13 @@
}
if {[isatty stdin]
- && [isatty stdout]
- && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")
- && (![info exists ui_options(ports_noninteractive)] || $ui_options(ports_noninteractive) ne "yes")} {
- set ui_options(questions_yesno) portclient::questions::ui_ask_yesno
- set ui_options(questions_singlechoice) portclient::questions::ui_ask_singlechoice
- set ui_options(questions_multichoice) portclient::questions::ui_ask_multichoice
+ && [isatty stdout]
+ && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")
+ && (![info exists ui_options(ports_noninteractive)] || $ui_options(ports_noninteractive) ne "yes")} {
+ set ui_options(questions_yesno) portclient::questions::ui_ask_yesno
+ set ui_options(questions_singlechoice) portclient::questions::ui_ask_singlechoice
+ set ui_options(questions_multichoice) portclient::questions::ui_ask_multichoice
+ set ui_options(questions_alternative) portclient::questions::ui_ask_alternative
}
set ui_options(notifications_append) portclient::notifications::append
Modified: branches/vcs-fetch/base/src/port/portindex.tcl
===================================================================
--- branches/vcs-fetch/base/src/port/portindex.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port/portindex.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -106,7 +106,7 @@
set portfile [file join $absportdir Portfile]
# try to reuse the existing entry if it's still valid
if {$full_reindex != 1 && [info exists qindex($qname)]} {
- try {
+ try -pass_signal {
set mtime [file mtime $portfile]
if {$oldmtime >= $mtime} {
lassign [_read_index $qname] name len line
@@ -129,10 +129,6 @@
return
}
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- throw
} catch {{*} eCode eMessage} {
ui_warn "Failed to open old entry for ${portdir}, making a new one"
if {[info exists ui_options(ports_debug)]} {
@@ -142,7 +138,7 @@
}
incr stats(total)
- try {
+ try -pass_signal {
_open_port portinfo $portdir $absportdir port_options
puts "Adding port $portdir"
@@ -158,24 +154,16 @@
}
foreach sub $portinfo(subports) {
incr stats(total)
- try {
+ try -pass_signal {
_open_port portinfo $portdir $absportdir port_options $sub
puts "Adding subport $sub"
_write_index_from_portinfo portinfo yes
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- throw
} catch {{*} eCode eMessage} {
puts stderr "Failed to parse file $portdir/Portfile with subport '${sub}': $eMessage"
incr stats(failed)
}
}
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- throw
} catch {{*} eCode eMessage} {
puts stderr "Failed to parse file $portdir/Portfile: $eMessage"
incr stats(failed)
Modified: branches/vcs-fetch/base/src/port1.0/portbuild.tcl
===================================================================
--- branches/vcs-fetch/base/src/port1.0/portbuild.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port1.0/portbuild.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -134,14 +134,20 @@
set jobs $buildmakejobs
# if set to '0', use the number of cores for the number of jobs
if {$jobs == 0} {
- if {[catch {set jobs [sysctl hw.activecpu]}] || [catch {set memsize [sysctl hw.memsize]}]} {
- set jobs 2
+ try -pass_signal {
+ set jobs [sysctl hw.activecpu]
+ } catch {{*} eCode eMessage} {
ui_warn "failed to determine the number of available CPUs (probably not supported on this platform)"
ui_warn "defaulting to $jobs jobs, consider setting buildmakejobs to a nonzero value in macports.conf"
+ set jobs 2
}
- if {[info exists memsize] && $jobs > $memsize / 1000000000 + 1} {
- set jobs [expr {$memsize / 1000000000 + 1}]
- }
+
+ try -pass_signal {
+ set memsize [sysctl hw.memsize]
+ if {$jobs > $memsize / (1024 * 1024 * 1024) + 1} {
+ set jobs [expr {$memsize / (1024 * 1024 * 1024) + 1}]
+ }
+ } catch {*} {}
}
if {![string is integer -strict $jobs] || $jobs <= 1} {
set jobs 1
Modified: branches/vcs-fetch/base/src/port1.0/portclean.tcl
===================================================================
--- branches/vcs-fetch/base/src/port1.0/portclean.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port1.0/portclean.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -214,14 +214,8 @@
if {[file isdirectory $subbuildpath]} {
ui_debug "Removing directory: ${subbuildpath}"
- try {
+ try -pass_signal {
delete $subbuildpath
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGINT"]
- throw
- } catch {{POSIX SIG SINTERM} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGTERM"]
- throw
} catch {{*} eCode eMessage} {
ui_debug "$::errorInfo"
ui_error "$eMessage"
@@ -234,14 +228,8 @@
if {!$usealtworkpath && [file isdirectory ${altprefix}${subbuildpath}]} {
ui_debug "Removing directory: ${altprefix}${subbuildpath}"
- try {
+ try -pass_signal {
delete ${altprefix}${subbuildpath}
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGINT"]
- throw
- } catch {{POSIX SIG SINTERM} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGTERM"]
- throw
} catch {{*} eCode eMessage} {
ui_debug "$::errorInfo"
ui_error "$eMessage"
Modified: branches/vcs-fetch/base/src/port1.0/portdistcheck.tcl
===================================================================
--- branches/vcs-fetch/base/src/port1.0/portdistcheck.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port1.0/portdistcheck.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -85,18 +85,12 @@
foreach site $urlmap($url_var) {
ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
set file_url [portfetch::assemble_url $site $distfile]
- try {
+ try -pass_signal {
set urlnewer [curl isnewer {*}$curl_options $file_url $port_moddate]
if {$urlnewer} {
ui_warn "port $subport: $file_url is newer than Portfile"
}
incr count
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGINT"]
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGTERM"]
- throw
} catch {{*} eCode eMessage} {
ui_debug [msgcat::mc "couldn't fetch %s for %s (%s)" $file_url $subport $eMessage]
}
@@ -109,7 +103,7 @@
foreach site $urlmap($url_var) {
ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
set file_url [portfetch::assemble_url $site $distfile]
- try {
+ try -pass_signal {
set urlsize [curl getsize {*}$curl_options $file_url]
incr count
if {$urlsize > 0} {
@@ -117,12 +111,6 @@
incr totalsize $urlsize
break
}
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGINT"]
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted due to SIGTERM"]
- throw
} catch {{*} eCode eMessage} {
ui_debug [msgcat::mc "couldn't fetch %s for %s (%s)" $file_url $subport $eMessage]
}
Modified: branches/vcs-fetch/base/src/port1.0/portfetch.tcl
===================================================================
--- branches/vcs-fetch/base/src/port1.0/portfetch.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port1.0/portfetch.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -535,7 +535,7 @@
foreach {url_var distfile} $fetch_urls {
if {![file isfile "${distpath}/${distfile}"]} {
- ui_info "$UI_PREFIX [format [msgcat::mc "%s doesn't seem to exist in %s"] $distfile $distpath]"
+ ui_info "$UI_PREFIX [format [msgcat::mc "%s does not exist in %s"] $distfile $distpath]"
if {![file writable $distpath]} {
return -code error [format [msgcat::mc "%s must be writable"] $distpath]
}
@@ -560,22 +560,16 @@
foreach site $urlmap($url_var) {
ui_notice "$UI_PREFIX [format [msgcat::mc "Attempting to fetch %s from %s"] $distfile $site]"
set file_url [portfetch::assemble_url $site $distfile]
- try {
+ try -pass_signal {
curl fetch {*}$fetch_options $file_url "${distpath}/${distfile}.TMP"
file rename -force "${distpath}/${distfile}.TMP" "${distpath}/${distfile}"
set fetched 1
break
- } catch {{POSIX SIG SIGINT} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted fetching distfile due to SIGINT"]
- file delete -force "${distpath}/${distfile}.TMP"
- throw
- } catch {{POSIX SIG SIGTERM} eCode eMessage} {
- ui_debug [msgcat::mc "Aborted fetching distfile due to SIGTERM"]
- file delete -force "${distpath}/${distfile}.TMP"
- throw
} catch {{*} eCode eMessage} {
ui_debug [msgcat::mc "Fetching distfile failed: %s" $eMessage]
set lastError $eMessage
+ } finally {
+ file delete -force "${distpath}/${distfile}.TMP"
}
}
if {![info exists fetched]} {
Modified: branches/vcs-fetch/base/src/port1.0/portutil.tcl
===================================================================
--- branches/vcs-fetch/base/src/port1.0/portutil.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port1.0/portutil.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -449,6 +449,7 @@
array set env [array get ${varprefix}.env_array]
# Call the command.
set fullcmdstring "$command_prefix $cmdstring $command_suffix"
+ ui_info "Executing: $fullcmdstring"
set code [catch {system {*}$notty {*}$nice $fullcmdstring} result]
# Save variables in order to re-throw the same error code.
set errcode $::errorCode
Modified: branches/vcs-fetch/base/src/port1.0/tests/portactivate.test
===================================================================
--- branches/vcs-fetch/base/src/port1.0/tests/portactivate.test 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/port1.0/tests/portactivate.test 2016-03-23 23:51:56 UTC (rev 147031)
@@ -19,38 +19,70 @@
macports_worker_init
-test activate_start {
- Activate start unit test.
- Requires root for setting euid.
-} -constraints {
- root
-} -setup {
+set activate_start_fixture_setup {
+ global prefix
+
+ set _save_prefix ${prefix}
+ file mkdir ${pwd}/tmpdir
+ set prefix ${pwd}/tmpdir
+
+ rename getuid _save_getuid
+ rename geteuid _save_geteuid
+
+ set fake_uid 0
+ set fake_euid 0
+ set elevateToRootCalls [list]
+
+ proc getuid {} {
+ global fake_uid
+ return ${fake_uid}
+ }
+ proc geteuid {} {
+ global fake_euid
+ return ${fake_euid}
+ }
+
+ proc elevateToRoot {phase} {
+ global elevateToRootCalls
+ lappend elevateToRootCalls $phase
+ }
+}
+set activate_start_fixture_cleanup {
+ rename getuid ""
+ rename geteuid ""
+
+ rename _save_getuid getuid
+ rename _save_geteuid geteuid
+
+ file delete -force ${pwd}/tmpdir
+}
+
+test activate_start_elevate {
+ Test portactivate::activate_start to make sure it elevates to root if necessary
+} -setup $activate_start_fixture_setup -cleanup $activate_start_fixture_cleanup -body {
# file writable $prefix is used to determine whether privilege escalation
# is needed, so set prefix to a directory unwritable for this user
set prefix /usr/bin
+ set fake_uid 0
+ set fake_euid 500
- # elevateToRoot uses $euid and $egid as the IDs to set
- set euid 0
- set egid 0
+ portactivate::activate_start
-} -body {
- # drop privileges; the code won't attempt to elevate privileges without
- # that
- seteuid 333
- if {[catch {portactivate::activate_start args}] != 0} {
- return "FAIL: couldn't elevate privileges"
- }
+ return ${elevateToRootCalls}
+} -result [list "activate"] -errorOutput ""
- # when uid == 0 and euid == 0, the code will not attempt to elevate
- # privileges
- seteuid 0
- if {[catch {portactivate::activate_start args}] != 0} {
- return "FAIL: couldn't elevate privileges"
- }
- return "Activate_start successful."
-} -result "Activate_start successful."
+test activate_start_noelevate {
+ Test portactivate::activate_start to make sure that it does not elevate to root if it cannot
+} -setup $activate_start_fixture_setup -cleanup $activate_start_fixture_cleanup -body {
+ set fake_uid 500
+ set fake_euid 500
+ portactivate::activate_start
+ return ${elevateToRootCalls}
+} -result [list] -errorOutput ""
+
+
test activate_main {
Activate main unit test.
} -constraints {
@@ -100,7 +132,7 @@
array set macports::channels $oldchannels
mportclose $mport
-} -result "Port activate successful."
+} -result "Port activate successful." -errorOutput ""
cleanupTests
Copied: branches/vcs-fetch/base/src/port1.0/tests/portbuild.test (from rev 147030, trunk/base/src/port1.0/tests/portbuild.test)
===================================================================
--- branches/vcs-fetch/base/src/port1.0/tests/portbuild.test (rev 0)
+++ branches/vcs-fetch/base/src/port1.0/tests/portbuild.test 2016-03-23 23:51:56 UTC (rev 147031)
@@ -0,0 +1,139 @@
+# -*- 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
+
+package require tcltest 2
+namespace import tcltest::*
+
+set pwd [file dirname [file normalize $argv0]]
+
+source ../port_test_autoconf.tcl
+package require macports 1.0
+
+array set ui_options {}
+#set ui_options(ports_debug) yes
+#set ui_options(ports_verbose) yes
+mportinit ui_options
+
+# Provide a stub for the port callback mechanism
+namespace eval port {
+ proc register_callback {args} {}
+ proc run_callbacks {args} {}
+}
+
+package require portbuild 1.0
+
+set build_getjobs_fixture_setup {
+ # Move away sysctl and replace it with our own implementation
+ rename sysctl sysctl_backup
+ proc sysctl {sysctlname} {
+ global _activecpus _memsize _activecpus_fail _memsize_fail
+ switch -exact $sysctlname {
+ hw.activecpu {
+ if {${_activecpus_fail}} {
+ error "error requested"
+ }
+ return ${_activecpus}
+ }
+ hw.memsize {
+ if {${_memsize_fail}} {
+ error "error requested"
+ }
+ return [expr {${_memsize} * 1024 * 1024 * 1024}]
+ }
+ default {
+ error "Unknown sysctl property $sysctlname"
+ }
+ }
+ }
+}
+set build_getjobs_fixture_cleanup {
+ global buildmakejobs
+
+ # Restore modified state
+ rename sysctl ""
+ rename sysctl_backup sysctl
+}
+
+test build_getjobs_auto_cpubound {
+ Verify that portbuild::build_getjobs correctly computes the number of parallel executors in the CPU-bound case
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ # Make sure that buildmakejobs is 0 so the auto-detection is being run
+ set buildmakejobs 0
+ set _activecpus 8
+ set _activecpus_fail no
+ set _memsize 16
+ set _memsize_fail no
+
+ return [portbuild::build_getjobs]
+} -result 8
+
+test build_getjobs_auto_memlimited {
+ Verify that portbuild::build_getjobs correctly computes the number of parallel executors in the memory-bound case
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ # Make sure that buildmakejobs is 0 so the auto-detection is being run
+ set buildmakejobs 0
+ set _activecpus 8
+ set _activecpus_fail no
+ set _memsize 4
+ set _memsize_fail no
+
+ return [portbuild::build_getjobs]
+} -result 5
+
+test build_getjobs_configured {
+ Verify that portbuild::build_getjobs correctly returns the number of configured parallel executors
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ set buildmakejobs 42
+ return [portbuild::build_getjobs]
+} -result 42
+
+test build_getjobs_nonnegative {
+ Verify that portbuild::build_getjobs doesn't return negative numbers, even if configured
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ set buildmakejobs -42
+ return [portbuild::build_getjobs]
+} -result 1
+
+test build_getjobs_nonnumeric {
+ Verify that portbuild::build_getjobs doesn't return junk if the configuration is non-numeric
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ set buildmakejobs "foobar"
+ return [portbuild::build_getjobs]
+} -result 1
+
+test build_getjobs_cpus_fail {
+ Verify that a failing [sysctl hw.activecpus] will print a warning
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ # Make sure that buildmakejobs is 0 so the auto-detection is being run
+ set buildmakejobs 0
+ set _activecpus_fail yes
+
+ return [portbuild::build_getjobs]
+} -result 2 -match glob -errorOutput "Warning:*failed to determine the number of available CPUs*"
+
+test build_getjobs_mem_fail {
+ Verify that a failing [sysctl hw.memsize] will print a warning
+} -setup $build_getjobs_fixture_setup -cleanup $build_getjobs_fixture_cleanup -body {
+ global buildmakejobs
+
+ # Make sure that buildmakejobs is 0 so the auto-detection is being run
+ set buildmakejobs 0
+ set _activecpus 8
+ set _activecpus_fail no
+ set _memsize_fail yes
+
+ return [portbuild::build_getjobs]
+} -result 8
+
+cleanupTests
Modified: branches/vcs-fetch/base/src/registry2.0/portimage.tcl
===================================================================
--- branches/vcs-fetch/base/src/registry2.0/portimage.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/registry2.0/portimage.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -252,8 +252,7 @@
}
if {[info exists macports::ui_options(questions_singlechoice)]} {
set retvalue [$macports::ui_options(questions_singlechoice) $msg "Choice_Q1" $portilist]
- set index [expr { $retvalue - 1 }]
- return [lindex $ilist $index]
+ return [lindex $ilist $retvalue]
}
throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
} elseif { [llength $ilist] == 1 } {
Modified: branches/vcs-fetch/base/src/registry2.0/portuninstall.tcl
===================================================================
--- branches/vcs-fetch/base/src/registry2.0/portuninstall.tcl 2016-03-23 13:41:22 UTC (rev 147030)
+++ branches/vcs-fetch/base/src/registry2.0/portuninstall.tcl 2016-03-23 23:51:56 UTC (rev 147031)
@@ -174,7 +174,7 @@
if {[info exists macports::ui_options(questions_multichoice)]} {
set retstring [$macports::ui_options(questions_multichoice) $msg "Choice_Q2" $portilist]
foreach index $retstring {
- set uport [lindex $sortedlist [expr { $index - 1 }]]
+ set uport [lindex $sortedlist $index]
uninstall [$uport name] [$uport version] [$uport revision] [$uport variants]
}
return 0
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20160323/a99ce152/attachment-0001.html>
More information about the macports-changes
mailing list