source: trunk/base/src/images_to_archives.tcl.in @ 118562

Last change on this file since 118562 was 118559, checked in by cal@…, 6 years ago

base: remove macports_fastload.tcl, use correct Tcl, install port-tclsh for contrib software, specify LD_LIBRARY_PATH for intree Tcl for Linux, see #43208

macports_fastload.tcl contained two blocks of code: The first one was dead
because it was only used with Tcl < 8.5, the second one sourced the pkgIndex.tcl
files of all MacPorts Tcl packages. That was previously necessary to ensure
package require macports 1.0 would load the code from the correct prefix and
might also have improved performance because $auto_path of /usr/bin/tclsh
contains 10 entries. With our local copy of Tcl, the number of files read is
around 100 at most, so I think that's a non-issue from a performance POV. We
don't need the preloading to select the correct MacPorts prefix, because the
selection of the Tcl interpreter now does that for us correctly.

For this to work correctly, every Tcl file must now be executed with the correct
Tcl interpreter -- that replaces sourcing macports_fastload.tcl from the correct
prefix. Some of our install scripts still used /usr/bin/env tclsh.

This change also solves a potential build problem on Linux in src/pkg_mkindex.sh
because the Tcl library matching the in-tree Tcl interpreter might not be found
without LD_LIBRARY_PATH.

Furthermore, this adds a $prefix/bin/port-tclsh wrapper script that should be
used by contrib tools that need to use the MacPorts API. The shebang line should
be

#!/usr/bin/env port-tclsh

which will cause the contrib script to automatically work on the port
installation currently first in $PATH.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 5.8 KB
Line 
1#!@TCLSH@
2# -*- 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
3# $Id: images_to_archives.tcl.in 118559 2014-04-04 22:02:44Z cal@macports.org $
4
5# convert existing port image directories into compressed archive versions
6# Takes one argument, which should be TCL_PACKAGE_DIR.
7
8package require macports 1.0
9package require registry 1.0
10package require registry2 2.0
11package require Pextlib 1.0
12
13umask 022
14
15array set ui_options {ports_verbose yes}
16
17mportinit ui_options
18
19# always converting to tbz2 should be fine as both these programs are
20# needed elsewhere and assumed to be available
21set tarcmd [macports::findBinary tar ${macports::autoconf::tar_path}]
22set bzip2cmd [macports::findBinary bzip2 ${macports::autoconf::bzip2_path}]
23
24if {[catch {set ilist [registry::installed]}]} {
25    # no ports installed
26    puts "No ports installed to convert."
27    exit 0
28}
29
30puts "This could take a while..."
31
32# list of ports we successfully create an archive of, to be used to update
33# the registry only after we know all creation attempts were successful.
34set archived_list {}
35set installed_len [llength $ilist]
36set counter 0
37
38foreach installed $ilist {
39    incr counter
40    set iname [lindex $installed 0]
41    set iversion [lindex $installed 1]
42    set irevision [lindex $installed 2]
43    set ivariants [lindex $installed 3]
44    set iepoch [lindex $installed 5]
45    set iref [registry::open_entry $iname $iversion $irevision $ivariants $iepoch]
46    set installtype [registry::property_retrieve $iref installtype]
47    if {$installtype eq "image"} {
48        set location [registry::property_retrieve $iref location]
49        if {$location == 0} {
50            set location [registry::property_retrieve $iref imagedir]
51        }
52    } else {
53        set location ""
54    }
55
56    if {$location eq "" || ![file isfile $location]} {
57        # no image archive present, so make one
58        set archs [registry::property_retrieve $iref archs]
59        if {$archs eq "" || $archs == 0} {
60            set archs ${macports::os_arch}
61        }
62        # look for any existing archive in the old location
63        set oldarchiverootname "${iname}-${iversion}_${irevision}${ivariants}.[join $archs -]"
64        set archivetype tbz2
65        set oldarchivedir [file join ${macports::portdbpath} packages ${macports::os_platform}_${macports::os_major}]
66        set olderarchivedir [file join ${macports::portdbpath} packages ${macports::os_platform}]
67        if {[llength $archs] == 1} {
68            set oldarchivedir [file join $oldarchivedir $archs $iname]
69            set olderarchivedir [file join $olderarchivedir $archs]
70        } else {
71            set oldarchivedir [file join $oldarchivedir universal $iname]
72            set olderarchivedir [file join $olderarchivedir universal]
73        }
74        set found 0
75        foreach adir [list $oldarchivedir $olderarchivedir] {
76            foreach type {tbz2 tbz tgz tar txz tlz xar zip cpgz cpio} {
77                set oldarchivefullpath "[file join $adir $oldarchiverootname].${type}"
78                if {[file isfile $oldarchivefullpath]} {
79                    set found 1
80                    set archivetype $type
81                    break
82                }
83            }
84            if {$found} {break}
85        }
86
87        # compute new name and location of archive
88        set archivename "${iname}-${iversion}_${irevision}${ivariants}.${macports::os_platform}_${macports::os_major}.[join $archs -].${archivetype}"
89        ui_msg "Processing ${counter} of ${installed_len}: ${archivename}"
90        if {$installtype eq "image"} {
91            set targetdir [file dirname $location]
92        } else {
93            set targetdir [file join ${macports::registry.path} software ${iname}]
94        }
95        if {$location eq "" || ![file isdirectory $location]} {
96            set contents [$iref imagefiles]
97        }
98        file mkdir $targetdir
99        set newlocation [file join $targetdir $archivename]
100
101        if {$found} {
102            file rename $oldarchivefullpath $newlocation
103        } elseif {$installtype eq "image" && [file isdirectory $location]} {
104            # create archive from image dir
105            system -W $location "$tarcmd -cjf $newlocation * > ${targetdir}/error.log 2>&1"
106            file delete -force ${targetdir}/error.log
107        } else {
108            # direct mode (or missing image dir), create archive from installed files
109            # we tell tar to read filenames from a file so as not to run afoul of command line length limits
110            set fd [open ${targetdir}/tarlist w]
111            foreach entry $contents {
112                puts $fd $entry
113            }
114            close $fd
115            system "$tarcmd -cjf $newlocation -T ${targetdir}/tarlist > ${targetdir}/error.log 2>&1"
116            file delete -force ${targetdir}/tarlist ${targetdir}/error.log
117        }
118
119        lappend archived_list [list $installtype $iref $location $newlocation]
120    }
121}
122
123set archived_len [llength $archived_list]
124set counter 0
125
126registry::write {
127    foreach archived $archived_list {
128        incr counter
129        ui_msg "Updating registry: ${counter} of ${archived_len}"
130        set installtype [lindex $archived 0]
131        set iref [lindex $archived 1]
132        set newlocation [lindex $archived 3]
133   
134        if {$installtype eq "direct"} {
135            # change receipt to image
136            $iref installtype image
137            $iref state imaged
138            $iref activate [$iref imagefiles]
139            $iref state installed
140        }
141   
142        # set the new location in the registry and delete the old dir
143        $iref location $newlocation
144    }
145}
146
147set counter 0
148foreach archived $archived_list {
149    incr counter
150    set location [lindex $archived 2]
151    ui_msg "Deleting ${counter} of ${archived_len}: ${location}"
152    if {$location ne "" && [file isdirectory $location]} {
153        if {[catch {file delete -force $location} result]} {
154            ui_warn "Failed to delete ${location}: $result"
155        }
156    }
157}
158
159exit 0
Note: See TracBrowser for help on using the repository browser.