Changeset 134990


Ignore:
Timestamp:
Apr 12, 2015, 10:41:16 PM (5 years ago)
Author:
cal@…
Message:

base: refactor portindex, move common code into separate function, make signal-safe to allow SIGINT/SIGTERM

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/base/src/port/portindex.tcl

    r118559 r134990  
    3131}
    3232
     33proc _read_index {idx} {
     34    global qindex oldfd
     35
     36    set offset $qindex($idx)
     37    seek $oldfd $offset
     38    gets $oldfd line
     39
     40    set name [lindex $line 0]
     41    set len  [lindex $line 1]
     42    set line [read $oldfd [expr {$len - 1}]]
     43
     44    return [list $name $len $line]
     45}
     46
     47proc _write_index {name len line} {
     48    global fd
     49
     50    puts $fd [list $name $len]
     51    puts $fd $line
     52}
     53
     54proc _write_index_from_portinfo {portinfoname {is_subport no}} {
     55    global keepkeys
     56
     57    upvar $portinfoname portinfo
     58
     59    array set keep_portinfo {}
     60    foreach key [array names keepkeys] {
     61        # filter keys
     62        if {![info exists portinfo($key)]} {
     63            continue
     64        }
     65
     66        # copy values we want to keep
     67        set keep_portinfo($key) $portinfo($key)
     68    }
     69
     70    # if this is not a subport, add the "subports" key
     71    if {!$is_subport && [info exists portinfo(subports)]} {
     72        set keep_portinfo(subports) $portinfo(subports)
     73    }
     74
     75    set output [array get keep_portinfo]
     76    set len [expr {[string length $output] + 1}]
     77    _write_index $portinfo(name) $len $output
     78}
     79
     80proc _open_port {portinfo_name portdir absportdir port_options_name {subport {}}} {
     81    global save_prefix
     82    upvar $portinfo_name portinfo
     83    upvar $port_options_name port_options
     84
     85    if {$subport eq {}} {
     86        set interp [mportopen file://$absportdir $port_options]
     87    } else {
     88        set interp [mportopen file://$absportdir [concat $port_options subport $subport]]
     89    }
     90
     91    if {[array exists portinfo]} {
     92        array unset portinfo
     93    }
     94    array set portinfo [mportinfo $interp]
     95    mportclose $interp
     96
     97    set portinfo(portdir) $portdir
     98}
     99
    33100proc pindex {portdir} {
    34101    global target oldfd oldmtime newest qindex fd directory outdir stats full_reindex \
    35102           ui_options port_options save_prefix keepkeys
    36103
     104    set qname [string tolower [file tail $portdir]]
     105    set absportdir [file join $directory $portdir]
     106    set portfile [file join $absportdir Portfile]
    37107    # try to reuse the existing entry if it's still valid
    38     if {$full_reindex != 1 && [info exists qindex([string tolower [file tail $portdir]])]} {
     108    if {$full_reindex != 1 && [info exists qindex($qname)]} {
    39109        try {
    40             set mtime [file mtime [file join $directory $portdir Portfile]]
     110            set mtime [file mtime $portfile]
    41111            if {$oldmtime >= $mtime} {
    42                 set offset $qindex([string tolower [file tail $portdir]])
    43                 seek $oldfd $offset
    44                 gets $oldfd line
    45                 set name [lindex $line 0]
    46                 set len [lindex $line 1]
    47                 set line [read $oldfd $len]
     112                lassign [_read_index $qname] name len line
     113                _write_index $name $len $line
     114                incr stats(skipped)
    48115
    49116                if {[info exists ui_options(ports_debug)]} {
    50117                    puts "Reusing existing entry for $portdir"
    51118                }
    52 
    53                 puts $fd [list $name $len]
    54                 puts -nonewline $fd $line
    55 
    56                 incr stats(skipped)
    57119
    58120                # also reuse the entries for its subports
     
    62124                }
    63125                foreach sub $portinfo(subports) {
    64                     set offset $qindex([string tolower $sub])
    65                     seek $oldfd $offset
    66                     gets $oldfd line
    67                     set name [lindex $line 0]
    68                     set len [lindex $line 1]
    69                     set line [read $oldfd $len]
    70    
    71                     puts $fd [list $name $len]
    72                     puts -nonewline $fd $line
    73    
     126                    _write_index {*}[_read_index [string tolower $sub]]
    74127                    incr stats(skipped)
    75128                }
     
    77130                return
    78131            }
    79         } catch {*} {
    80             ui_warn "failed to open old entry for ${portdir}, making a new one"
     132        } catch {{POSIX SIG SIGINT} eCode eMessage} {
     133            throw
     134        } catch {{POSIX SIG SIGTERM} eCode eMessage} {
     135            throw
     136        } catch {{*} eCode eMessage} {
     137            ui_warn "Failed to open old entry for ${portdir}, making a new one"
     138            if {[info exists ui_options(ports_debug)]} {
     139                puts "$::errorInfo"
     140            }
    81141        }
    82142    }
    83143
    84144    incr stats(total)
    85     set prefix {\${prefix}}
    86     if {[catch {set interp [mportopen file://[file join $directory $portdir] $port_options]} result]} {
    87         puts stderr "Failed to parse file $portdir/Portfile: $result"
    88         # revert the prefix.
    89         set prefix $save_prefix
    90         incr stats(failed)
    91     } else {
    92         # revert the prefix.
    93         set prefix $save_prefix
    94         array set portinfo [mportinfo $interp]
    95         mportclose $interp
    96         set portinfo(portdir) $portdir
     145    try {
     146        _open_port portinfo $portdir $absportdir port_options
    97147        puts "Adding port $portdir"
    98148
    99         foreach availkey [array names portinfo] {
    100             # store list of subports for top-level ports only
    101             if {![info exists keepkeys($availkey)] && $availkey ne "subports"} {
    102                 unset portinfo($availkey)
    103             }
    104         }
    105         set output [array get portinfo]
    106         set len [expr {[string length $output] + 1}]
    107         puts $fd [list $portinfo(name) $len]
    108         puts $fd $output
    109         set mtime [file mtime [file join $directory $portdir Portfile]]
     149        _write_index_from_portinfo portinfo
     150        set mtime [file mtime $portfile]
    110151        if {$mtime > $newest} {
    111152            set newest $mtime
    112153        }
     154
    113155        # now index this portfile's subports (if any)
    114156        if {![info exists portinfo(subports)]} {
     
    117159        foreach sub $portinfo(subports) {
    118160            incr stats(total)
    119             set prefix {\${prefix}}
    120             if {[catch {set interp [mportopen file://[file join $directory $portdir] [concat $port_options subport $sub]]} result]} {
    121                 puts stderr "Failed to parse file $portdir/Portfile with subport '${sub}': $result"
    122                 set prefix $save_prefix
     161            try {
     162                _open_port portinfo $portdir $absportdir port_options $sub
     163                puts "Adding subport $sub"
     164
     165                _write_index_from_portinfo portinfo yes
     166            } catch {{POSIX SIG SIGINT} eCode eMessage} {
     167                throw
     168            } catch {{POSIX SIG SIGTERM} eCode eMessage} {
     169                throw
     170            } catch {{*} eCode eMessage} {
     171                puts stderr "Failed to parse file $portdir/Portfile with subport '${sub}': $eMessage"
    123172                incr stats(failed)
    124             } else {
    125                 set prefix $save_prefix
    126                 array unset portinfo
    127                 array set portinfo [mportinfo $interp]
    128                 mportclose $interp
    129                 set portinfo(portdir) $portdir
    130                 puts "Adding subport $sub"
    131                 foreach availkey [array names portinfo] {
    132                     if {![info exists keepkeys($availkey)]} {
    133                         unset portinfo($availkey)
    134                     }
    135                 }
    136                 set output [array get portinfo]
    137                 set len [expr {[string length $output] + 1}]
    138                 puts $fd [list $portinfo(name) $len]
    139                 puts $fd $output
    140             }
    141         }
     173            }
     174        }
     175    } catch {{POSIX SIG SIGINT} eCode eMessage} {
     176        throw
     177    } catch {{POSIX SIG SIGTERM} eCode eMessage} {
     178        throw
     179    } catch {{*} eCode eMessage} {
     180        puts stderr "Failed to parse file $portdir/Portfile: $eMessage"
     181        incr stats(failed)
    142182    }
    143183}
     
    237277    set keepkeys($key) 1
    238278}
    239 mporttraverse pindex $directory
    240 if {[info exists oldfd]} {
    241     close $oldfd
    242 }
    243 close $fd
     279
     280set exit_fail 0
     281try {
     282    mporttraverse pindex $directory
     283} catch {{POSIX SIG SIGINT} eCode eMessage} {
     284    puts stderr "SIGINT received, terminating."
     285    set exit_fail 1
     286} catch {{POSIX SIG SIGTERM} eCode eMessage} {
     287    puts stderr "SIGTERM received, terminating."
     288    set exit_fail 1
     289} finally {
     290    if {[info exists oldfd]} {
     291        close $oldfd
     292    }
     293    close $fd
     294}
     295if {$exit_fail} {
     296    exit 1
     297}
     298
    244299file rename -force $tempportindex $outpath
    245300file mtime $outpath $newest
Note: See TracChangeset for help on using the changeset viewer.