source: branches/images-and-archives/base/src/port1.0/portimagefile.tcl @ 51705

Last change on this file since 51705 was 51705, checked in by blb@…, 8 years ago

Centralize naming of imagefile within macports.tcl

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 7.9 KB
Line 
1# portimagefile.tcl
2# $Id: portimagefile.tcl 51705 2009-06-01 06:04:37Z blb@macports.org $
3#
4# Copyright (c) 2009 The MacPorts Project
5# All rights reserved.
6#
7# Redistribution and use in source and binary forms, with or without
8# modification, are permitted provided that the following conditions
9# are met:
10# 1. Redistributions of source code must retain the above copyright
11#    notice, this list of conditions and the following disclaimer.
12# 2. Redistributions in binary form must reproduce the above copyright
13#    notice, this list of conditions and the following disclaimer in the
14#    documentation and/or other materials provided with the distribution.
15# 3. Neither the name of The MacPorts Project nor the names of its contributors
16#    may be used to endorse or promote products derived from this software
17#    without specific prior written permission.
18#
19# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
20# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
23# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
26# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
27# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
28# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
29# POSSIBILITY OF SUCH DAMAGE.
30#
31
32package provide portimagefile 1.0
33package require portutil 1.0
34
35set org.macports.imagefile [target_new org.macports.imagefile portimagefile::imagefile_main]
36target_provides ${org.macports.imagefile} imagefile
37target_requires ${org.macports.imagefile} main fetch checksum extract patch configure build destroot
38target_prerun ${org.macports.imagefile} portimagefile::imagefile_start
39
40namespace eval portimagefile {
41}
42
43set_ui_prefix
44
45proc portimagefile::imagefile_start {args} {
46    global UI_PREFIX name version revision portvariants
47    ui_msg "$UI_PREFIX [format [msgcat::mc "Imaging %s @%s_%s%s"] $name $version $revision $portvariants]"
48
49    return 0
50}
51
52
53proc portimagefile::imagefile_main {args} {
54    global name version revision portvariants epoch destpath
55    global workpath portpath
56    set startpwd [pwd]
57    if {[catch {_cd $destpath} err]} {
58        ui_error $err
59        return
60    }
61    if {[catch {set tarcmd [findBinary tar ${portutil::autoconf::tar_path}]} err]} {
62        ui_error $err
63        return
64    }
65    if {[catch {set bzipcmd [findBinary bzip2 ${portutil::autoconf::bzip2_path}]} err]} {
66        ui_error $err
67        return
68    }
69    set imageworkpath [file join $workpath image]
70    file mkdir $imageworkpath
71    ui_debug "Creating files.tar.bz2"
72    if {[catch {system "$tarcmd -cvf - * | $bzipcmd -c > [file join $imageworkpath files.tar.bz2]"} err]} {
73        ui_error $err
74        return
75    }
76    # Copy Portfile into imageworkpath to be included in image file
77    file copy [file join $portpath Portfile] [file join $imageworkpath "+PORTFILE"]
78    create_image_receipt $imageworkpath
79    _cd $imageworkpath
80    set macport_filename [getportimagename_from_port_info $name $epoch $version $revision $portvariants]
81    set macport_file [file join $workpath $macport_filename]
82    ui_debug "Creating $macport_filename"
83    if {[catch {system "$tarcmd -cvf $macport_file *"} err]} {
84        ui_error $err
85        return
86    }
87
88    install_register_imagefile $macport_file
89
90    _cd $startpwd
91
92    return 0
93}
94
95
96# Create a +IMAGERECEIPT file which contains all information necessary
97# to register the port in the MacPorts registry
98proc portimagefile::create_image_receipt {imageworkpath} {
99    global name version revision portvariants epoch categories
100    global homepage maintainers depends_run depends_lib prefix package-install
101    global description long_description license destpath
102    set fd [open [file join $imageworkpath "+IMAGERECEIPT"] w]
103    set variablelist {name version revision portvariants epoch categories homepage maintainers depends_run depends_lib prefix package-install description long_description license}
104    foreach onevar $variablelist {
105        if {[info exists $onevar]} {
106            puts $fd "$onevar [string map {\n \\n} [set $onevar]]"
107        }
108    }
109    puts $fd "contents [filelist_for_path $destpath]"
110    close $fd
111
112    return 0
113}
114
115
116# Build up a list of information which describes each file within the
117# destroot, which matches that information which is found in receipts.
118proc portimagefile::filelist_for_path {startpath} {
119    if {[string index $startpath end] == "/"} {
120        set startpath [string range $startpath 0 end-1]
121    }
122    set filelist {}
123    fs-traverse element $startpath {
124        if {![file isdirectory $element]} {
125            # registry_fileinfo_for_file only works on files which exist
126            # so we must run it against the stuff in the destroot, then strip
127            # out that path to get to what will be the final install path
128            set fileinfo [registry_fileinfo_for_file $element]
129            lappend filelist [regsub -all "$startpath" $fileinfo ""]
130        }
131    }
132
133    return $filelist
134}
135
136
137# Install (copy to portimagefilepath) an imagefile and register
138# it as installed in the MacPorts registry.  This makes no assumptions
139# about how the imagefile was created/acquired
140proc portimagefile::install_register_imagefile {imagefile} {
141    global env portimagefilepath prefix
142    if {[info exists env(TMPDIR)]} {
143        set mytempdir [mkdtemp [file join $env(TMPDIR) mpimageXXXXXXXX]]
144    } else {
145        set mytempdir [mkdtemp [file join /tmp mpimageXXXXXXXX]]
146    }
147    set startpwd [pwd]
148    try {
149        if {[catch {_cd $mytempdir} err]} {
150            throw MACPORTS $err
151        }
152        if {[catch {set tarcmd [findBinary tar ${portutil::autoconf::tar_path}]} err]} {
153            throw MACPORTS $err
154        }
155        if {[catch {system "$tarcmd -xvf $imagefile +IMAGERECEIPT"} err]} {
156            throw MACPORTS $err
157        }
158        if {[catch {set fd [open "+IMAGERECEIPT" r]} err]} {
159            throw MACPORTS "Can't open image receipt: $err"
160        }
161        array set imagevars [list]
162        while {[gets $fd line] >= 0} {
163            set imagevars([lindex $line 0]) [lrange $line 1 end]
164        }
165        close $fd
166        set requiredvars {name version revision portvariants epoch categories contents prefix}
167        foreach required $requiredvars {
168            if {![info exists imagevars($required)]} {
169                throw MACPORTS "Image receipt missing required variable $required"
170            }
171        }
172
173        if {$imagevars(prefix) != $prefix} {
174            throw MACPORTS "Image prefix ($imagevars(prefix)) does not match ours ($prefix)"
175        }
176        set portimagepath [file join ${portimagefilepath} $imagevars(name)]
177        if {![file isdirectory $portimagepath]} {
178            file mkdir $portimagepath
179        }
180        ui_debug "Installing and registering [file tail $imagefile]"
181        file copy -force $imagefile $portimagepath
182
183        set regref [registry_new $imagevars(name) $imagevars(version) $imagevars(revision) $imagevars(portvariants) $imagevars(epoch)]
184        registry_prop_store $regref categories $imagevars(categories)
185        registry_prop_store $regref contents $imagevars(contents)
186        foreach propname [array names imagevars] {
187            if {[lsearch -exact $requiredvars $propname] >= 0} {
188                continue
189            }
190            registry_prop_store $regref $propname $imagevars($propname)
191            if {[lsearch -exact {depends_run depends_lib} $propname] != -1} {
192               registry_register_deps $imagevars($propname) $imagevars(name)
193            }
194        }
195        registry_write $regref
196    } catch {* errorCode errorMessage } {
197        ui_error $errorMessage
198    } finally {
199        _cd $startpwd
200        file delete -force $mytempdir
201    }
202
203    return 0
204}
205
Note: See TracBrowser for help on using the repository browser.