source: branches/gsoc13-tests/portmgr/jobs/port_binary_distributable.tcl @ 111323

Last change on this file since 111323 was 111323, checked in by marius@…, 7 years ago

Merge from trunk.

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 11.6 KB
Line 
1#!/usr/bin/tclsh
2# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
3#
4# $Id: port_binary_distributable.tcl 111323 2013-09-18 23:11:02Z marius@macports.org $
5#
6# Check that binaries of a port are distributable by looking at its license
7# and the licenses of its dependencies.
8#
9# Expected format: A {B C} means the license is A plus either B or C.
10#
11# Exit status:
12# 0: distributable
13# 1: non-distributable
14# 2: error
15
16
17set MY_VERSION 0.1
18
19array set portsSeen {}
20
21set check_deptypes {depends_build depends_lib}
22
23
24# Notes:
25# 'Restrictive/Distributable' means a non-free license that nonetheless allows
26# distributing binaries.
27# 'Restrictive' means a non-free license that does not allow distributing
28# binaries, and is thus not in the list.
29# 'Permissive' is a catchall for other licenses that allow
30# modification and distribution of source and binaries.
31# 'Copyleft' means a license that requires source code to be made available,
32# and derivative works to be licensed the same as the original.
33# 'GPLConflict' should be added if the license conflicts with the GPL (and its
34# variants like CeCILL and the AGPL) and is not in the list of licenses known
35# to do so below.
36# 'Noncommercial' means a license that prohibits commercial use.
37set good_licenses {afl agpl apache apsl artistic autoconf beopen bitstreamvera \
38                   boost bsd bsd-old cddl cecill cecill-b cecill-c cnri copyleft \
39                   cpl curl epl fpll fontconfig freetype gd gfdl gpl \
40                   gplconflict ibmpl ijg isc jasper lgpl libtool lppl mit \
41                   mpl ncsa noncommercial openldap openssl permissive php \
42                   psf public-domain qpl restrictive/distributable ruby \
43                   sleepycat ssleay tcl/tk vim w3c wtfpl wxwidgets x11 zlib zpl}
44foreach lic $good_licenses {
45    set license_good($lic) 1
46}
47
48proc all_licenses_except { args } {
49    global good_licenses
50    set remaining $good_licenses
51    foreach arg $args {
52        set remaining [lsearch -inline -all -not -exact $remaining $arg]
53    }
54    return [list $remaining]
55}
56
57# keep these values sorted
58array set license_conflicts \
59    "afl {agpl cecill gpl}
60    agpl {afl apache-1 apache-1.1 apsl beopen bsd-old cddl cecill cnri cpl epl gd gpl-1 gpl-2 gplconflict ibmpl lppl mpl noncommercial openssl php qpl restrictive/distributable ruby ssleay zpl-1}
61    agpl-1 {apache freetype gpl-3 gpl-3+ lgpl-3 lgpl-3+}
62    apache {agpl-1 cecill gpl-1 gpl-2}
63    apache-1 {agpl gpl}
64    apache-1.1 {agpl gpl}
65    apsl {agpl cecill gpl}
66    beopen {agpl cecill gpl}
67    bsd-old {agpl cecill gpl}
68    cddl {agpl cecill gpl}
69    cecill {afl agpl apache apsl beopen bsd-old cddl cnri cpl epl gd gplconflict ibmpl lppl mpl noncommercial openssl php qpl restrictive/distributable ruby ssleay zpl-1}
70    cnri {agpl cecill gpl}
71    cpl {agpl cecill gpl}
72    epl {agpl cecill gpl}
73    freetype {agpl-1 gpl-2}
74    gd {agpl cecill gpl}
75    gpl {afl apache-1 apache-1.1 apsl beopen cddl cnri bsd-old cpl epl gd gplconflict ibmpl lppl mpl noncommercial openssl php qpl restrictive/distributable ruby ssleay zpl-1}
76    gpl-1 {agpl apache gpl-3 gpl-3+ lgpl-3 lgpl-3+}
77    gpl-2 {agpl apache freetype gpl-3 gpl-3+ lgpl-3 lgpl-3+}
78    gpl-3 {agpl-1 gpl-1 gpl-2}
79    gpl-3+ {agpl-1 gpl-1 gpl-2}
80    gplconflict {agpl cecill gpl}
81    ibmpl {agpl cecill gpl}
82    lgpl-3 {agpl-1 gpl-1 gpl-2}
83    lgpl-3+ {agpl-1 gpl-1 gpl-2}
84    lppl {agpl cecill gpl}
85    mpl {agpl cecill gpl}
86    noncommercial {agpl cecill gpl}
87    openssl {agpl cecill gpl}
88    opensslexception [all_licenses_except openssl ssleay]
89    php {agpl cecill gpl}
90    qpl {agpl cecill gpl}
91    restrictive/distributable {agpl cecill gpl}
92    ruby {agpl cecill gpl}
93    ssleay {agpl cecill gpl}
94    zpl-1 {agpl cecill gpl}"
95
96proc printUsage {} {
97    puts "Usage: $::argv0 \[-hvV\] \[-t macports-tcl-path\] port-name \[variants...\]"
98    puts "  -h    This help"
99    puts "  -t    Give a different location for the base MacPorts Tcl"
100    puts "        file (defaults to /Library/Tcl)"
101    puts "  -v    verbose output"
102    puts "  -V    show version and MacPorts version being used"
103    puts ""
104    puts "port-name is the name of a port to check"
105    puts "variants is the list of variants to enable/disable: +one -two..."
106}
107
108
109# return deps and license for given port
110proc infoForPort {portName variantInfo} {
111    global check_deptypes
112    set dependencyList {}
113    set portSearchResult [mportlookup $portName]
114    if {[llength $portSearchResult] < 1} {
115        puts "Warning: port \"$portName\" not found"
116        return {}
117    }
118    array set portInfo [lindex $portSearchResult 1]
119    set mport [mportopen $portInfo(porturl) [list subport $portName] $variantInfo]
120    array unset portInfo
121    array set portInfo [mportinfo $mport]
122    mportclose $mport
123
124    foreach dependencyType $check_deptypes {
125        if {[info exists portInfo($dependencyType)] && [string length $portInfo($dependencyType)] > 0} {
126            foreach dependency $portInfo($dependencyType) {
127                set afterColon [expr {[string last ":" $dependency] + 1}]
128                lappend dependencyList [string range $dependency $afterColon end]
129            }
130        }
131    }
132
133    set ret [list $dependencyList $portInfo(license)]
134    if {[info exists portInfo(installs_libs)]} {
135        lappend ret $portInfo(installs_libs)
136    } else {
137        # when in doubt, assume code from the dep is incorporated
138        lappend ret yes
139    }
140    if {[info exists portInfo(license_noconflict)]} {
141        lappend ret $portInfo(license_noconflict)
142    }
143    return $ret
144}
145
146# return license with any trailing dash followed by a number and/or plus sign removed
147proc remove_version {license} {
148    set dash [string last - $license]
149    if {$dash != -1 && [regexp {[0-9.+]+} [string range $license [expr $dash + 1] end]]} {
150        return [string range $license 0 [expr $dash - 1]]
151    } else {
152        return $license
153    }
154}
155
156proc check_licenses {portName variantInfo verbose} {
157    global license_good license_conflicts
158    array set portSeen {}
159    set top_info [infoForPort $portName $variantInfo]
160    if {$top_info == {}} {
161        return 1
162    }
163    set top_license [lindex $top_info 1]
164    foreach noconflict_port [lindex $top_info 3] {
165        set noconflict_ports($noconflict_port) 1
166    }
167    set top_license_names {}
168    # check that top-level port's license(s) are good
169    foreach sublist $top_license {
170        # each element may be a list of alternatives (i.e. only one need apply)
171        set any_good 0
172        set sub_names {}
173        foreach full_lic $sublist {
174            # chop off any trailing version number
175            set lic [remove_version [string tolower $full_lic]]
176            # add name to the list for later
177            lappend sub_names $lic
178            if {[info exists license_good($lic)]} {
179                set any_good 1
180            }
181        }
182        lappend top_license_names $sub_names
183        if {!$any_good} {
184            if {$verbose} {
185                puts "\"$portName\" is not distributable because its license \"$lic\" is not known to be distributable"
186            }
187            return 1
188        }
189    }
190
191    # start with deps of top-level port
192    set portList [lindex $top_info 0]
193    while {[llength $portList] > 0} {
194        set aPort [lindex $portList 0]
195        # mark as seen and remove from the list
196        set portSeen($aPort) 1
197        set portList [lreplace $portList 0 0]
198        if {[info exists noconflict_ports($aPort)]} {
199            continue
200        }
201
202        set aPortInfo [infoForPort $aPort $variantInfo]
203        set aPortLicense [lindex $aPortInfo 1]
204        set installs_libs [lindex $aPortInfo 2]
205        if {!$installs_libs} {
206            continue
207        }
208        foreach sublist $aPortLicense {
209            set any_good 0
210            set any_compatible 0
211            # check that this dependency's license(s) are good
212            foreach full_lic $sublist {
213                set lic [remove_version [string tolower $full_lic]]
214                if {[info exists license_good($lic)]} {
215                    set any_good 1
216                } else {
217                    # no good being compatible with other licenses if it's not distributable itself
218                    continue
219                }
220
221                # ... and that they don't conflict with the top-level port's
222                set any_conflict 0
223                foreach top_sublist [concat $top_license $top_license_names] {
224                    set any_sub_compatible 0
225                    foreach top_lic $top_sublist {
226                        if {![info exists license_conflicts([string tolower $top_lic])]
227                            || ([lsearch -sorted $license_conflicts([string tolower $top_lic]) $lic] == -1
228                            && [lsearch -sorted $license_conflicts([string tolower $top_lic]) [string tolower $full_lic]] == -1)} {
229                            set any_sub_compatible 1
230                            break
231                        }
232                    }
233                    if {!$any_sub_compatible} {
234                        set any_conflict 1
235                        break
236                    }
237                }
238                if {!$any_conflict} {
239                    set any_compatible 1
240                    break
241                }
242            }
243
244            if {!$any_good} {
245                if {$verbose} {
246                    puts "\"$portName\" is not distributable because its dependency \"$aPort\" has license \"$lic\" which is not known to be distributable"
247                }
248                return 1
249            }
250            if {!$any_compatible} {
251                if {$verbose} {
252                    puts "\"$portName\" is not distributable because its license \"$top_lic\" conflicts with license \"$full_lic\" of dependency \"$aPort\""
253                }
254                return 1
255            }
256        }
257
258        # skip deps that are explicitly stated to not conflict
259        array unset aPort_noconflict_ports
260        foreach noconflict_port [lindex $aPortInfo 3] {
261            set aPort_noconflict_ports($noconflict_port) 1
262        }
263        # add its deps to the list
264        foreach possiblyNewPort [lindex $aPortInfo 0] {
265            if {![info exists portSeen($possiblyNewPort)] && ![info exists aPort_noconflict_ports($possiblyNewPort)]} {
266                lappend portList $possiblyNewPort
267            }
268        }
269    }
270
271    if {$verbose} {
272        puts "\"$portName\" is distributable"
273    }
274    return 0
275}
276
277
278# Begin
279
280set macportsTclPath /Library/Tcl
281set verbose 0
282set showVersion 0
283
284while {[string index [lindex $::argv 0] 0] == "-" } {
285    switch [string range [lindex $::argv 0] 1 end] {
286        h {
287            printUsage
288            exit 0
289        }
290        t {
291            if {[llength $::argv] < 2} {
292                puts "-t needs a path"
293                printUsage
294                exit 2
295            }
296            set macportsTclPath [lindex $::argv 1]
297            set ::argv [lrange $::argv 1 end]
298        }
299        v {
300             set verbose 1
301        }
302        V {
303            set showVersion 1
304        }
305        default {
306            puts "Unknown option [lindex $::argv 0]"
307            printUsage
308            exit 2
309        }
310    }
311    set ::argv [lrange $::argv 1 end]
312}
313
314source ${macportsTclPath}/macports1.0/macports_fastload.tcl
315package require macports
316mportinit
317
318if {$showVersion} {
319    puts "Version $MY_VERSION"
320    puts "MacPorts version [macports::version]"
321    exit 0
322}
323
324if {[llength $::argv] == 0} {
325    puts "Error: missing port-name"
326    printUsage
327    exit 2
328}
329set portName [lindex $::argv 0]
330set ::argv [lrange $::argv 1 end]
331
332array set variantInfo {}
333foreach variantSetting $::argv {
334    set flag [string index $variantSetting 0]
335    set variantName [string range $variantSetting 1 end]
336    set variantInfo($variantName) $flag
337}
338
339exit [check_licenses $portName [array get variantInfo] $verbose]
Note: See TracBrowser for help on using the repository browser.