source: trunk/base/src/port1.0/portdistcheck.tcl @ 119683

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

base: port1.0/portdistcheck.tcl: Replace eval with argument expansion

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 5.7 KB
Line 
1# et:ts=4
2# portdistcheck.tcl
3#
4# $Id: portdistcheck.tcl 119683 2014-05-03 21:59:55Z cal@macports.org $
5#
6# Copyright (c) 2007-2011 The MacPorts Project
7# Copyright (c) 2005-2006 Paul Guyot <pguyot@kallisys.net>,
8# All rights reserved.
9#
10# Redistribution and use in source and binary forms, with or without
11# modification, are permitted provided that the following conditions are
12# met:
13#
14# 1. Redistributions of source code must retain the above copyright
15#    notice, this list of conditions and the following disclaimer.
16# 2. Redistributions in binary form must reproduce the above copyright
17#    notice, this list of conditions and the following disclaimer in the
18#    documentation and/or other materials provided with the distribution.
19# 3. Neither the name of The MacPorts Project nor the names of its
20#    contributors may be used to endorse or promote products derived from
21#    this software without specific prior written permission.
22#
23# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
24# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
25# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
26# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
27# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
28# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
29# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
30# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
31# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
32# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
33# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34#
35
36package provide portdistcheck 1.0
37package require portutil 1.0
38package require portfetch 1.0
39
40set org.macports.distcheck [target_new org.macports.distcheck portdistcheck::distcheck_main]
41target_runtype ${org.macports.distcheck} always
42target_state ${org.macports.distcheck} no
43target_provides ${org.macports.distcheck} distcheck
44target_requires ${org.macports.distcheck} main
45
46namespace eval portdistcheck {
47}
48
49# define options
50options distcheck.type
51
52# defaults
53default distcheck.type moddate
54
55proc portdistcheck::distcheck_main {args} {
56    global distcheck.type fetch.type fetch.ignore_sslcert \
57           subport portpath
58
59    set port_moddate [file mtime ${portpath}/Portfile]
60
61    ui_debug "Portfile modification date is [clock format $port_moddate]"
62
63    set curl_options {}
64    if {[tbool fetch.ignore_sslcert]} {
65        lappend curl_options "--ignore-ssl-cert"
66    }
67
68    # Check the distfiles if it's a regular fetch phase.
69    if {"${distcheck.type}" != "none"
70        && "${fetch.type}" == "standard"} {
71        # portfetch 1.0::checkfiles sets fetch_urls list.
72        set fetch_urls {}
73        portfetch::checkfiles fetch_urls
74        set totalsize 0
75
76        # Check all the files.
77        foreach {url_var distfile} $fetch_urls {
78            global portfetch::urlmap
79            if {![info exists urlmap($url_var)]} {
80                ui_error [format [msgcat::mc "No defined site for tag: %s, using master_sites"] $url_var]
81                set urlmap($url_var) $master_sites
82            }
83            if {${distcheck.type} == "moddate"} {
84                set count 0
85                foreach site $urlmap($url_var) {
86                    ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
87                    set file_url [portfetch::assemble_url $site $distfile]
88                    if {[catch {set urlnewer [curl isnewer {*}$curl_options $file_url $port_moddate]} error]} {
89                        ui_warn "couldn't fetch $file_url for $subport ($error)"
90                    } else {
91                        if {$urlnewer} {
92                            ui_warn "port $subport: $file_url is newer than Portfile"
93                        }
94                        incr count
95                    }
96                }
97                if {$count == 0} {
98                    ui_error "no mirror had $distfile for $subport"
99                }
100            } elseif {${distcheck.type} == "filesize"} {
101                set count 0
102                foreach site $urlmap($url_var) {
103                    ui_debug [format [msgcat::mc "Checking %s from %s"] $distfile $site]
104                    set file_url [portfetch::assemble_url $site $distfile]
105                    if {[catch {set urlsize [curl getsize {*}$curl_options $file_url]} error]} {
106                        ui_warn "couldn't fetch $file_url for $subport ($error)"
107                    } else {
108                        incr count
109                        if {$urlsize > 0} {
110                            ui_info "port $subport: $distfile $urlsize bytes"
111                            incr totalsize $urlsize
112                            break
113                        }
114                    }
115                }
116                if {$count == 0} {
117                    ui_error "no mirror had $distfile for $subport"
118                }
119            } else {
120                ui_error "unknown distcheck.type ${distcheck.type}"
121                break
122            }
123        }
124
125        if {${distcheck.type} == "filesize" && $totalsize > 0} {
126            if {$totalsize < 1024} {
127                set size $totalsize
128                set humansize "${size}"
129            } elseif {$totalsize < 1024*1024} {
130                set size [expr {$totalsize / 1024.0}]
131                set humansize [format "%.1fK" $size]
132            } elseif {$totalsize < 1024*1024*1024} {
133                set size [expr {$totalsize / (1024.0*1024.0)}]
134                set humansize [format "%.1fM" $size]
135            } else {
136                set size [expr {$totalsize / (1024.0*1024.0*1024.0)}]
137                set humansize [format "%.1fG" $size]
138            }
139            ui_msg "$subport: $humansize"
140        }
141    }
142}
Note: See TracBrowser for help on using the repository browser.