source: trunk/base/src/port1.0/portclean.tcl @ 106617

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

bring back clean --archive since files can persist in incoming/ in some circumstances

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 11.7 KB
Line 
1# -*- 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
2# $Id: portclean.tcl 106617 2013-06-01 08:55:55Z jmr@macports.org $
3#
4# Copyright (c) 2005-2007, 2009-2011, 2013 The MacPorts Project
5# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
6# Copyright (c) 2002 - 2003 Apple Inc.
7# All rights reserved.
8#
9# Redistribution and use in source and binary forms, with or without
10# modification, are permitted provided that the following conditions
11# are met:
12# 1. Redistributions of source code must retain the above copyright
13#    notice, this list of conditions and the following disclaimer.
14# 2. Redistributions in binary form must reproduce the above copyright
15#    notice, this list of conditions and the following disclaimer in the
16#    documentation and/or other materials provided with the distribution.
17# 3. Neither the name of Apple Inc. nor the names of its contributors
18#    may be used to endorse or promote products derived from this software
19#    without specific prior written permission.
20#
21# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
22# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
25# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
26# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
27# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
29# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31# POSSIBILITY OF SUCH DAMAGE.
32#
33
34# the 'clean' target is provided by this package
35
36package provide portclean 1.0
37package require portutil 1.0
38package require Pextlib 1.0
39
40set org.macports.clean [target_new org.macports.clean portclean::clean_main]
41target_runtype ${org.macports.clean} always
42target_state ${org.macports.clean} no
43target_provides ${org.macports.clean} clean
44target_requires ${org.macports.clean} main
45target_prerun ${org.macports.clean} portclean::clean_start
46
47namespace eval portclean {
48}
49
50set_ui_prefix
51
52proc portclean::clean_start {args} {
53    global UI_PREFIX prefix
54
55    ui_notice "$UI_PREFIX [format [msgcat::mc "Cleaning %s"] [option subport]]"
56
57    if {[getuid] == 0 && [geteuid] != 0} {
58        elevateToRoot "clean"
59    }
60}
61
62proc portclean::clean_main {args} {
63    global UI_PREFIX ports_clean_dist ports_clean_work ports_clean_logs \
64           ports_clean_archive ports_clean_all keeplogs usealtworkpath
65
66    if {$usealtworkpath} {
67        ui_warn "Only cleaning in ~/.macports; insufficient privileges for standard locations"
68    }
69
70    if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
71        [info exists ports_clean_dist] && $ports_clean_dist == "yes"} {
72        ui_info "$UI_PREFIX [format [msgcat::mc "Removing distfiles for %s"] [option subport]]"
73        clean_dist
74    }
75    if {([info exists ports_clean_all] && $ports_clean_all == "yes" || \
76        [info exists ports_clean_archive] && $ports_clean_archive == "yes")
77        && !$usealtworkpath} {
78        ui_info "$UI_PREFIX [format [msgcat::mc "Removing temporary archives for %s"] [option subport]]"
79        clean_archive
80    }
81    if {[info exists ports_clean_all] && $ports_clean_all == "yes" || \
82        [info exists ports_clean_work] && $ports_clean_work == "yes" || \
83        [info exists ports_clean_archive] && $ports_clean_archive == "yes" || \
84        [info exists ports_clean_dist] && $ports_clean_dist == "yes" || \
85        !([info exists ports_clean_logs] && $ports_clean_logs == "yes")} {
86         ui_info "$UI_PREFIX [format [msgcat::mc "Removing work directory for %s"] [option subport]]"
87         clean_work
88    }
89    if {(([info exists ports_clean_logs] && $ports_clean_logs == "yes") || ($keeplogs == "no"))
90        && !$usealtworkpath} {
91        clean_logs
92    }
93
94    return 0
95}
96
97#
98# Remove the directory where the distfiles reside.
99# This is crude, but works.
100#
101proc portclean::clean_dist {args} {
102    global name ports_force distpath dist_subdir distfiles patchfiles usealtworkpath portdbpath altprefix
103
104    # remove known distfiles for sure (if they exist)
105    set count 0
106    foreach file $distfiles {
107        set distfile [getdistname $file]
108        ui_debug "Looking for $distfile"
109        set distfile [file join $distpath $distfile]
110        if {[file isfile $distfile]} {
111            ui_debug "Removing file: $distfile"
112            if {[catch {delete $distfile} result]} {
113                ui_debug "$::errorInfo"
114                ui_error "$result"
115            }
116            incr count
117        }
118        if {!$usealtworkpath && [file isfile ${altprefix}${distfile}]} {
119            ui_debug "Removing file: ${altprefix}${distfile}"
120            if {[catch {delete ${altprefix}${distfile}} result]} {
121                ui_debug "$::errorInfo"
122                ui_error "$result"
123            }
124            incr count
125        }
126    }
127    if {$count > 0} {
128        ui_debug "$count distfile(s) removed."
129    } else {
130        ui_debug "No distfiles found to remove at $distpath"
131    }
132
133    set count 0
134    if {![info exists patchfiles]} {
135        set patchfiles ""
136    }
137    foreach file $patchfiles {
138        set patchfile [getdistname $file]
139        ui_debug "Looking for $patchfile"
140        set patchfile [file join $distpath $patchfile]
141        if {[file isfile $patchfile]} {
142            ui_debug "Removing file: $patchfile"
143            if {[catch {delete $patchfile} result]} {
144                ui_debug "$::errorInfo"
145                ui_error "$result"
146            }
147            incr count
148        }
149        if {!$usealtworkpath && [file isfile ${altprefix}${patchfile}]} {
150            ui_debug "Removing file: ${altprefix}${patchfile}"
151            if {[catch {delete ${altprefix}${patchfile}} result]} {
152                ui_debug "$::errorInfo"
153                ui_error "$result"
154            }
155            incr count
156        }
157    }
158    if {$count > 0} {
159        ui_debug "$count patchfile(s) removed."
160    } else {
161        ui_debug "No patchfiles found to remove at $distpath"
162    }
163
164    # next remove dist_subdir if only needed for this port,
165    # or if user forces us to
166    set dirlist [list]
167    if {$dist_subdir != $name} {
168        if {!([info exists ports_force] && $ports_force == "yes")
169            && [file isdirectory $distpath]
170            && [llength [readdir $distpath]] > 0} {
171            ui_warn [format [msgcat::mc "Distfiles directory '%s' may contain distfiles needed for other ports, use the -f flag to force removal" ] $distpath]
172        } else {
173            lappend dirlist $dist_subdir
174            lappend dirlist $name
175        }
176    } else {
177        lappend dirlist $name
178    }
179    # loop through directories
180    set count 0
181    foreach dir $dirlist {
182        if {$usealtworkpath} {
183            set distdir [file join ${altprefix}${portdbpath} distfiles $dir]
184        } else {
185            set distdir [file join ${portdbpath} distfiles $dir]
186        }
187        if {[file isdirectory $distdir]} {
188            ui_debug "Removing directory: ${distdir}"
189            if {[catch {delete $distdir} result]} {
190                ui_debug "$::errorInfo"
191                ui_error "$result"
192            }
193            incr count
194        }
195        if {!$usealtworkpath && [file isdirectory ${altprefix}${distdir}]} {
196            ui_debug "Removing directory: ${altprefix}${distdir}"
197            if {[catch {delete ${altprefix}${distdir}} result]} {
198                ui_debug "$::errorInfo"
199                ui_error "$result"
200            }
201            incr count
202        }
203    }
204    if {$count > 0} {
205        ui_debug "$count distfile directory(s) removed."
206    } else {
207        ui_debug "No distfile directory found to remove."
208    }
209    return 0
210}
211
212proc portclean::clean_work {args} {
213    global portbuildpath subbuildpath worksymlink usealtworkpath altprefix portpath
214
215    if {[file isdirectory $subbuildpath]} {
216        ui_debug "Removing directory: ${subbuildpath}"
217        if {[catch {delete $subbuildpath} result]} {
218            ui_debug "$::errorInfo"
219            ui_error "$result"
220        }
221        # silently fail if non-empty (other subports might be using portbuildpath)
222        catch {file delete $portbuildpath}
223    } else {
224        ui_debug "No work directory found to remove at ${subbuildpath}"
225    }
226
227    if {!$usealtworkpath && [file isdirectory ${altprefix}${subbuildpath}]} {
228        ui_debug "Removing directory: ${altprefix}${subbuildpath}"
229        if {[catch {delete ${altprefix}${subbuildpath}} result]} {
230            ui_debug "$::errorInfo"
231            ui_error "$result"
232        }
233        catch {file delete ${altprefix}${portbuildpath}}
234    } else {
235        ui_debug "No work directory found to remove at ${altprefix}${subbuildpath}"
236    }
237
238    # Clean symlink, if necessary
239    if {![catch {file type $worksymlink} result] && $result eq "link"} {
240        ui_debug "Removing symlink: $worksymlink"
241        delete $worksymlink
242    }
243   
244    # clean port dir in alt prefix
245    if {[file exists "${altprefix}${portpath}"]} {
246        ui_debug "removing ${altprefix}${portpath}"
247        delete "${altprefix}${portpath}"
248    }
249
250    return 0
251}
252proc portclean::clean_logs {args} {
253    global portpath portbuildpath worksymlink portverbose keeplogs prefix subport
254    set logpath [getportlogpath $portpath]
255    set subdir [file join $logpath $subport]
256        if {[file isdirectory $subdir]} {
257        ui_debug "Removing directory: ${subdir}"
258        if {[catch {delete $subdir} result]} {
259            ui_debug "$::errorInfo"
260            ui_error "$result"
261        }
262        catch {file delete $logpath}
263    } else {
264        ui_debug "No log directory found to remove at ${logpath}"
265    }                   
266    return 0
267}
268
269proc portclean::clean_archive {args} {
270    global subport ports_version_glob portdbpath
271
272    # Define archive destination directory, target filename, regex for archive name
273    set archivepath [file join $portdbpath incoming]
274
275    if {[info exists ports_version_glob]} {
276        # Match all possible archive variants that match the version
277        # glob specified by the user.
278        set fileglob "$subport-[option ports_version_glob]*.*.*.*"
279    } else {
280        # Match all possible archives for this port.
281        set fileglob "$subport-*_*.*.*.*"
282    }
283
284    # Remove the archive files
285    set count 0
286    foreach dir [list $archivepath ${archivepath}/verified] {
287        set archivelist [glob -nocomplain -directory $dir $fileglob]
288        foreach path $archivelist {
289            # Make sure file is truly an archive file for this port, and not
290            # an accidental match with some other file that might exist. Also
291            # delete anything ending in .TMP since those are incomplete and
292            # thus can't be checked and aren't useful anyway.
293            set archivetype [string range [file extension $path] 1 end]
294            if {[file isfile $path] && ($archivetype == "TMP"
295                || [extract_archive_metadata $path $archivetype portname] == $subport)} {
296                ui_debug "Removing archive: $path"
297                if {[catch {delete $path} result]} {
298                    ui_debug "$::errorInfo"
299                    ui_error "$result"
300                }
301                if {[file isfile ${path}.rmd160]} {
302                    ui_debug "Removing archive signature: ${path}.rmd160"
303                    if {[catch {delete ${path}.rmd160} result]} {
304                        ui_debug "$::errorInfo"
305                        ui_error "$result"
306                    }
307                }
308                incr count
309            }
310        }
311    }
312    if {$count > 0} {
313        ui_debug "$count archive(s) removed."
314    } else {
315        ui_debug "No archives found to remove at $archivepath"
316    }
317
318    return 0
319}
Note: See TracBrowser for help on using the repository browser.