source: trunk/base/src/images_to_archives.tcl @ 80178

Last change on this file since 80178 was 80178, checked in by jmr@…, 9 years ago

turn on ports_verbose in images_to_archives

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