source: trunk/base/src/port1.0/portsubmit.tcl @ 50562

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

base/src - detab and remove space-at-end-of-line

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 9.5 KB
Line 
1# et:ts=4
2# portsubmit.tcl
3# $Id: portsubmit.tcl 50562 2009-05-04 04:15:01Z blb@macports.org $
4#
5# Copyright (c) 2002 - 2004 Apple Computer, Inc.
6# All rights reserved.
7#
8# Redistribution and use in source and binary forms, with or without
9# modification, are permitted provided that the following conditions
10# are met:
11# 1. Redistributions of source code must retain the above copyright
12#    notice, this list of conditions and the following disclaimer.
13# 2. Redistributions in binary form must reproduce the above copyright
14#    notice, this list of conditions and the following disclaimer in the
15#    documentation and/or other materials provided with the distribution.
16# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
17#    may be used to endorse or promote products derived from this software
18#    without specific prior written permission.
19#
20# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
24# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
25# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
26# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
28# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30# POSSIBILITY OF SUCH DAMAGE.
31#
32
33package provide portsubmit 1.0
34package require portutil 1.0
35package require portportpkg 1.0
36
37set org.macports.submit [target_new org.macports.submit portsubmit::submit_main]
38target_runtype ${org.macports.submit} always
39target_provides ${org.macports.submit} submit
40target_requires ${org.macports.submit} portpkg
41
42namespace eval portsubmit {
43}
44
45set_ui_prefix
46
47
48# escape quotes, and things that make the shell cry
49proc portsubmit::shell_escape {str} {
50    regsub -all -- {\\} $str {\\\\} str
51    regsub -all -- {"} $str {\"} str
52    regsub -all -- {'} $str {\'} str
53    return $str
54}
55
56
57proc portsubmit::submit_main {args} {
58    global mp_remote_submit_url portname portversion portverbose prefix UI_PREFIX workpath portpath
59
60    set submiturl $mp_remote_submit_url
61
62    # Preconditions for submit
63    if {$submitter_email == ""} {
64        return -code error [format [msgcat::mc "Submitter email is required to submit a port"]]
65    }
66
67    # Make sure we have a work directory
68    file mkdir ${workpath}
69
70    # Create portpkg.xar in the work directory
71    set pkgpath "${workpath}/${portname}.portpkg"
72
73    # TODO: If a private key was provided, create a signed digest of the submission
74
75    # Submit to the submit url
76    set args "curl"
77    lappend args "--silent"
78    lappend args "--url ${submiturl}"
79    lappend args "--output ${workpath}/.portsubmit.out"
80    lappend args "-F machine=true"
81    lappend args "-F portpkg=@${pkgpath}"
82    #lappend args "-F signeddigest=${digest}"
83    set cmd [join $args]
84
85    if {[tbool portverbose]} {
86        ui_msg "Submitting portpkg $pkgpath for $portname to $submiturl"
87    }
88
89    # Invoke curl to do the submit
90    ui_debug $cmd
91    if {[system $cmd] != ""} {
92        return -code error [format [msgcat::mc "Failure during submit of port %s"] $portname]
93    }
94
95    # Parse the result
96    set fd [open ${workpath}/.portsubmit.out r]
97    array set result [list]
98    while {[gets $fd line] != -1} {
99        if {0 != [regexp -- {^([^:]+):\s*(.*)$} $line unused key value]} {
100            set result($key) $value
101        }
102    }
103    close $fd
104
105    # Interpret and act on the result
106    if {[info exists result(MESSAGE)] && [tbool portverbose]} {
107        ui_msg $result(MESSAGE)
108    }
109    if {[info exists result(STATUS)]} {
110        if { $result(STATUS) == 0 } {
111            ui_msg "Submitted portpkg for $portname"
112            if {[info exists result(DOWNLOAD_URL)]} {
113                ui_msg "    download URL => $result(DOWNLOAD_URL)"
114            }
115            if {[info exists result(HUMAN_URL)]} {
116                ui_msg "    human readable URL => $result(HUMAN_URL)"
117            }
118        } else {
119            return -code error [format [msgcat::mc "Status %d reported during submit of port %s"] $result(STATUS) $portname]
120        }
121    } else {
122        return -code error [format [msgcat::mc "Status not received during submit of port %s"] $portname]
123    }
124
125    return
126
127    # REMNANTS OF KEVIN'S CODE
128
129    # start with the Portfile, and add the files directory if it exists.
130    # don't pick up any CVS directories, or .DS_Store turds
131    set cmd "tar czvf ${workpath}/Portfile.tar.gz "
132    append cmd "--exclude CVS --exclude .DS_Store "
133    append cmd "Portfile "
134    if {[file isdirectory "files"]} {
135        append cmd "files "
136    }
137
138    if {[system $cmd] != ""} {
139    return -code error [format [msgcat::mc "Failed to archive port : %s"] $portname]
140    }
141
142    set portsource ""
143    set base_rev ""
144    if {![catch {set fd [open ".mports_source" r]}]} {
145        while {[gets $fd line] != -1} {
146            regexp -- {^(.*): (.*)$} $line unused key value
147            switch -- $key {
148                source { set portsource $value }
149                revision { set base_rev $value }
150            }
151        }
152        close $fd
153    }
154    if {$portsource == ""} {
155        ui_msg "$UI_PREFIX Submitting $portname-$portversion"
156        puts -nonewline "URL: "
157        flush stdout
158        gets stdin portsource
159    }
160
161    ui_msg "$UI_PREFIX Submitting $portname-$portversion to $portsource"
162
163    puts -nonewline "Username: "
164    flush stdout
165    gets stdin username
166    puts -nonewline "Password: "
167    flush stdout
168    exec stty -echo
169    gets stdin password
170    puts ""
171    exec stty echo
172
173    set vars {portname portversion maintainers categories description \
174        long_description master_sites}
175    eval "global $vars"
176    foreach var $vars {
177        if {![info exists $var]} { set $var {} }
178    }
179
180    set cmd "curl "
181    append cmd "--silent "
182    append cmd "--url [regsub -- {^mports} $portsource {http}]/cgi-bin/portsubmit.cgi "
183    append cmd "--output ${workpath}/.portsubmit.out "
184    append cmd "-F name=${portname} "
185    append cmd "-F version=${portversion} "
186    append cmd "-F base_rev=${base_rev} "
187    append cmd "-F md5=[md5 file ${workpath}/Portfile.tar.gz] "
188    append cmd "-F attachment=@${workpath}/Portfile.tar.gz "
189    append cmd "-F \"submitted_by=[shell_escape $username]\" "
190    append cmd "-F \"password=[shell_escape $password]\" "
191    append cmd "-F \"maintainers=[shell_escape $maintainers]\" "
192    append cmd "-F \"categories=[shell_escape $categories]\" "
193    append cmd "-F \"description=[shell_escape $description]\" "
194    append cmd "-F \"long_description=[shell_escape $long_description]\" "
195    append cmd "-F \"master_sites=[shell_escape $master_sites]\" "
196
197    ui_debug $cmd
198    if {[system $cmd] != ""} {
199    return -code error [format [msgcat::mc "Failed to submit port : %s"] $portname]
200    }
201
202    #
203    # Parse the result from the remote index
204    # if ERROR: print the error message
205    # if OK: store the revision info
206    # if CONFLICT: attempt to merge the conflict
207    #
208
209    set fd [open ${workpath}/.portsubmit.out r]
210    array set result [list]
211    while {[gets $fd line] != -1} {
212        regexp -- {^(.*): (.*)$} $line unused key value
213        set result($key) $value
214    }
215    close $fd
216
217    if {[info exists result(OK)]} {
218        set fd [open ".mports_source" w]
219        puts $fd "source: $portsource"
220        puts $fd "port: $portname"
221        puts $fd "version: $portversion"
222        puts $fd "revision: $result(revision)"
223        close $fd
224
225        ui_msg "$portname-$portversion submitted successfully."
226        ui_msg "New revision: $result(revision)"
227    } elseif {[info exists result(ERROR)]} {
228        return -code error $result(ERROR)
229    } elseif {[info exists result(CONFLICT)]} {
230        # Fetch the newer revision from the index.
231        # XXX: many gross hacks here regarding paths, urls, etc.
232        set tmpdir [mktemp "/tmp/mports.XXXXXXXX"]
233        file mkdir $tmpdir/new
234        file mkdir $tmpdir/old
235        set worker [mport_open $portsource/files/$portname/$portversion/$result(revision)/Portfile.tar.gz [list portdir $tmpdir/new]]
236        if {$base_rev != ""} {
237            set worker2 [mport_open $portsource/files/$portname/$portversion/$base_rev/Portfile.tar.gz [list portdir $tmpdir/old]]
238            catch {system "diff3 -m -E -- $portpath/Portfile $tmpdir/old/$portname-$portversion/Portfile $tmpdir/new/$portname-$portversion/Portfile > $tmpdir/Portfile"}
239            file rename -force "${tmpdir}/Portfile" "${portpath}/Portfile"
240            mport_close $worker2
241        } else {
242            catch {system "diff3 -m -E -- $portpath/Portfile $portpath/Portfile $tmpdir/new/$portname-$portversion/Portfile > $tmpdir/Portfile"}
243            file rename -force "${tmpdir}/Portfile" "${portpath}/Portfile"
244        }
245        mport_close $worker
246        catch {delete "${tmpdir}"}
247
248        set fd [open [file join "$portpath" ".mports_source"] w]
249        puts $fd "source: $portsource"
250        puts $fd "port: $portname"
251        puts $fd "version: $portversion"
252        puts $fd "revision: $result(revision)"
253        close $fd
254
255        ui_error "A newer revision of this port has already been submitted."
256        ui_error "Portfile: $portname-$portversion"
257        ui_error "Base revision: $base_rev"
258        ui_error "Current revision: $result(revision)"
259        ui_error "Please edit the Portfile to resolve any conflicts and resubmit."
260    }
261
262    return 0
263}
Note: See TracBrowser for help on using the repository browser.