|
|
@@ -1,9 +1,32 @@ |
|
|
#!@TCLSH@ |
|
|
# -*- 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 |
|
|
# restore.tcl |
|
|
# |
|
|
# TODO: include MacPorts copyright |
|
|
# Copyright (c) 2017 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 migrate 1.0 |
|
|
|
|
|
@@ -41,22 +64,22 @@ namespace eval migrate { |
|
|
puts "here 1" |
|
|
|
|
|
# create a snapshot |
|
|
ui_msg "Taking a snapshot of the current state.." |
|
|
set snapshot [snapshot::main $opts] |
|
|
puts $snapshot |
|
|
puts [$snapshot note] |
|
|
puts [$snapshot created_at] |
|
|
set portlist1 [$snapshot ports] |
|
|
puts $portlist1 |
|
|
set note [$snapshot note] |
|
|
set datetime [$snapshot created_at] |
|
|
ui_msg "Done: snapshot '$note' created at $datetime" |
|
|
|
|
|
puts "\nhere 2\n" |
|
|
ui_msg "Fetching ports.." |
|
|
set portlist1 [$snapshot ports] |
|
|
|
|
|
# uninstall_installed $portlist1 |
|
|
ui_msg "Uninstalling all ports.." |
|
|
uninstall_installed $portlist1 |
|
|
|
|
|
ui_msg "Restoring the original state.." |
|
|
recover_ports_state $portlist1 |
|
|
|
|
|
|
|
|
# TODO: CLEAN PARTIAL BUILDS STEP HERE |
|
|
|
|
|
} |
|
|
|
|
|
proc fetch_snapshot { snapshot_id } { |
|
|
@@ -68,41 +91,13 @@ namespace eval migrate { |
|
|
return |
|
|
} |
|
|
|
|
|
proc port_dependencies {portName variantInfo} { |
|
|
|
|
|
set dependencyList [list] |
|
|
set portSearchResult [mportlookup $portName] |
|
|
|
|
|
# TODO: error handling, if any? |
|
|
array set portInfo [lindex $portSearchResult 1] |
|
|
|
|
|
if {[catch {set mport [mportopen $portInfo(porturl) [list subport $portInfo(name)] $variantInfo]} result]} { |
|
|
global errorInfo |
|
|
puts stderr "$errorInfo" |
|
|
return -code error "Unable to open port '$portName': $result" |
|
|
} |
|
|
array unset portInfo |
|
|
array set portInfo [mportinfo $mport] |
|
|
mportclose $mport |
|
|
|
|
|
set dependencyTypes { depends_fetch depends_extract depends_build depends_lib depends_run } |
|
|
foreach dependencyType $dependencyTypes { |
|
|
if {[info exists portInfo($dependencyType)] && [string length $portInfo($dependencyType)] > 0} { |
|
|
foreach dependency $portInfo($dependencyType) { |
|
|
lappend dependencyList [lindex [split $dependency:] end] |
|
|
} |
|
|
} |
|
|
} |
|
|
return $dependencyList |
|
|
} |
|
|
|
|
|
proc portlist_sort_dependencies_first {portlist} { |
|
|
|
|
|
array set port_installed {} |
|
|
array set port_deps {} |
|
|
array set port_in_list {} |
|
|
|
|
|
set newList [list] |
|
|
set new_list [list] |
|
|
|
|
|
foreach port $portlist { |
|
|
|
|
|
@@ -144,18 +139,16 @@ namespace eval migrate { |
|
|
} |
|
|
|
|
|
if {![info exists port_deps(${name},${variants})]} { |
|
|
set port_deps(${name},${variants}) [port_dependencies $name $variants] |
|
|
set port_deps(${name},${variants}) [portlist_sort_dependencies_first_helper $name $variants] |
|
|
} |
|
|
lappend newList [list $name $variants $active] |
|
|
lappend new_list [list $name $variants $active] |
|
|
} |
|
|
|
|
|
set operationList [list] |
|
|
|
|
|
while {[llength $newList] > 0} { |
|
|
|
|
|
set oldLen [llength $newList] |
|
|
set operation_list [list] |
|
|
while {[llength $new_list] > 0} { |
|
|
|
|
|
foreach port $newList { |
|
|
set oldLen [llength $new_list] |
|
|
foreach port $new_list { |
|
|
foreach {name variants active} $port break |
|
|
|
|
|
if {$active && $port_installed($name) < ($port_in_list($name) - 1)} { |
|
|
@@ -169,19 +162,44 @@ namespace eval migrate { |
|
|
} |
|
|
} |
|
|
if {$installable} { |
|
|
lappend operationList [list $name $variants $active] |
|
|
lappend operation_list [list $name $variants $active] |
|
|
incr port_installed($name) |
|
|
set index [lsearch $newList [list $name $variants $active]] |
|
|
set newList [lreplace $newList $index $index] |
|
|
set index [lsearch $new_list [list $name $variants $active]] |
|
|
set new_list [lreplace $new_list $index $index] |
|
|
} |
|
|
} |
|
|
|
|
|
if {[llength $newList] == $oldLen} { |
|
|
if {[llength $new_list] == $oldLen} { |
|
|
return -code error "Stuck in loop" |
|
|
} |
|
|
} |
|
|
return $operation_list |
|
|
} |
|
|
|
|
|
return $operationList |
|
|
proc portlist_sort_dependencies_first_helper {portname variant_info} { |
|
|
set dependency_list [list] |
|
|
set port_search_result [mportlookup $portname] |
|
|
if {[llength $port_search_result] < 2} { |
|
|
ui_warn "Skipping $portname (not in the ports tree)" |
|
|
return $dependency_list |
|
|
} |
|
|
array set portinfo [lindex $port_search_result 1] |
|
|
if {[catch {set mport [mportopen $portinfo(porturl) [list subport $portinfo(name)] $variant_info]} result]} { |
|
|
global errorInfo |
|
|
puts stderr "$errorInfo" |
|
|
return -code error "Unable to open port '$portname': $result" |
|
|
} |
|
|
array unset portinfo |
|
|
array set portinfo [mportinfo $mport] |
|
|
mportclose $mport |
|
|
set dependency_types { depends_fetch depends_extract depends_build depends_lib depends_run } |
|
|
foreach dependency_type $dependency_types { |
|
|
if {[info exists portinfo($dependency_type)] && [string length $portinfo($dependency_type)] > 0} { |
|
|
foreach dependency $portinfo($dependency_type) { |
|
|
lappend dependency_list [lindex [split $dependency:] end] |
|
|
} |
|
|
} |
|
|
} |
|
|
return $dependency_list |
|
|
} |
|
|
|
|
|
proc portlist_sort_dependencies_later {portlist} { |
|
|
@@ -196,8 +214,7 @@ namespace eval migrate { |
|
|
# the list in dependency-sorted order |
|
|
|
|
|
foreach port $portlist { |
|
|
|
|
|
set portname [$port name] |
|
|
set portname [lindex $port 0] |
|
|
lappend entries($portname) $port |
|
|
|
|
|
# Avoid adding ports in loop |
|
|
@@ -263,7 +280,6 @@ namespace eval migrate { |
|
|
|
|
|
proc recover_ports_state {portlist} { |
|
|
|
|
|
|
|
|
set sorted_portlist [portlist_sort_dependencies_first $portlist] |
|
|
|
|
|
foreach port $sorted_portlist { |
|
|
@@ -279,16 +295,16 @@ namespace eval migrate { |
|
|
|
|
|
if {!$active} { |
|
|
set target install |
|
|
ui_msg "Installing (not activating): $name $variations" |
|
|
} else { |
|
|
set target activate |
|
|
ui_msg "Installing (and activating): $name $variations" |
|
|
} |
|
|
|
|
|
puts "$name $variations $active $target" |
|
|
|
|
|
if {[catch {set res [mportlookup $name]} result]} { |
|
|
global errorInfo |
|
|
ui_debug "$errorInfo" |
|
|
return -code error "lookup of portname $name failed: $result" |
|
|
return -code error "lookup of port $name failed: $result" |
|
|
} |
|
|
if {[llength $res] < 2} { |
|
|
# not in the index, but we already warned about that earlier |
|
|
@@ -299,9 +315,12 @@ namespace eval migrate { |
|
|
array set portinfo [lindex $res 1] |
|
|
set porturl $portinfo(porturl) |
|
|
|
|
|
# TODO: error handling, if any? |
|
|
if {[catch {set workername [mportopen $porturl [list subport $portinfo(name)] $variations]} result]} { |
|
|
global errorInfo |
|
|
puts stderr "$errorInfo" |
|
|
return -code error "Unable to open port '$name': $result" |
|
|
} |
|
|
|
|
|
set workername [mportopen $porturl [list subport $portinfo(name)] $variations] |
|
|
if {[catch {set result [mportexec $workername $target]} result]} { |
|
|
global errorInfo |
|
|
mportclose $workername |
|
|
@@ -310,7 +329,7 @@ namespace eval migrate { |
|
|
} else { |
|
|
mportclose $workername |
|
|
} |
|
|
# TODO: dependencies active? |
|
|
# TODO: some ports may get re-activated to fulfil dependencies - recheck? |
|
|
} |
|
|
|
|
|
} |
|
|
|
