Skip to content
Permalink
Browse files

Keep repeatedly-used regexes in variables

This ensures that Tcl will store the compiled regex along with the string
representation of the variable.
  • Loading branch information
jmroot committed Jun 29, 2019
1 parent 1d6588d commit b81bcbbdb4f6ace3da420b3984ae61e76536568a
@@ -747,12 +747,13 @@ proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
}

# Process all configuration files we find on conf_files list
set conf_option_re {^(\w+)([ \t]+(.*))?$}
foreach file $conf_files {
if {[file exists $file]} {
set portconf $file
set fd [open $file r]
while {[gets $fd line] >= 0} {
if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
if {[regexp $conf_option_re $line match option ignore val] == 1} {
if {$option in $bootstrap_options} {
set macports::$option [string trim $val]
global macports::$option
@@ -768,7 +769,7 @@ proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
if {[file exists $per_user]} {
set fd [open $per_user r]
while {[gets $fd line] >= 0} {
if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
if {[regexp $conf_option_re $line match option ignore val] == 1} {
if {$option in $user_options} {
set macports::$option $val
global macports::$option
@@ -781,11 +782,13 @@ proc mportinit {{up_ui_options {}} {up_options {}} {up_variations {}}} {
if {![info exists sources_conf]} {
return -code error "sources_conf must be set in ${macports_conf_path}/macports.conf or in your ${macports_user_dir}/macports.conf file"
}
set sources_conf_comment_re {^\s*#|^$}
set sources_conf_source_re {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$}
set fd [open $sources_conf r]
while {[gets $fd line] >= 0} {
set line [string trimright $line]
if {![regexp {^\s*#|^$} $line]} {
if {[regexp {^([\w-]+://\S+)(?:\s+\[(\w+(?:,\w+)*)\])?$} $line _ url flags]} {
if {![regexp $sources_conf_comment_re $line]} {
if {[regexp $sources_conf_source_re $line _ url flags]} {
set flags [split $flags ,]
foreach flag $flags {
if {$flag ni [list nosync default]} {
@@ -825,14 +828,17 @@ Please edit sources.conf and change '$url' to '[string range $url 0 end-6]tarbal
set sources_default [lindex $sources end]
}

# regex also used by pubkeys.conf
set variants_conf_comment_re {^[\ \t]*#.*$|^$}
if {[info exists variants_conf]} {
if {[file exists $variants_conf]} {
set variants_conf_setting_re {^([-+])([-A-Za-z0-9_+\.]+)$}
set fd [open $variants_conf r]
while {[gets $fd line] >= 0} {
set line [string trimright $line]
if {![regexp {^[\ \t]*#.*$|^$} $line]} {
if {![regexp $variants_conf_comment_re $line]} {
foreach arg [split $line " \t"] {
if {[regexp {^([-+])([-A-Za-z0-9_+\.]+)$} $arg match sign opt] == 1} {
if {[regexp $variants_conf_setting_re $arg match sign opt] == 1} {
if {![info exists variations($opt)]} {
set variations($opt) $sign
}
@@ -856,7 +862,7 @@ Please edit sources.conf and change '$url' to '[string range $url 0 end-6]tarbal
set fd [open [file join $macports_conf_path pubkeys.conf] r]
while {[gets $fd line] >= 0} {
set line [string trim $line]
if {![regexp {^[\ \t]*#.*$|^$} $line]} {
if {![regexp $variants_conf_comment_re $line]} {
lappend macports::archivefetch_pubkeys $line
}
}
@@ -1665,8 +1671,9 @@ proc macports::fetch_port {url {local 0}} {
return [file join $fetchdir $portname]
}

set macports::getprotocol_re {(?x)([^:]+)://.+}
proc macports::getprotocol {url} {
if {[regexp {(?x)([^:]+)://.+} $url match protocol] == 1} {
if {[regexp $::macports::getprotocol_re $url match protocol] == 1} {
return $protocol
} else {
return -code error "Can't parse url $url"
@@ -1771,6 +1778,8 @@ proc macports::getdefaultportresourcepath {{path {}}} {
}


set macports::file_porturl_re {^file://(.*)}

##
# Opens a MacPorts portfile specified by a URL. The URL can be local (starting
# with file://), or remote (http, https, or ftp). In the local case, the URL
@@ -1796,7 +1805,7 @@ proc mportopen {porturl {options {}} {variations {}} {nocache {}}} {
global macports::portdbpath macports::portconf macports::open_mports auto_path

# normalize porturl for local files
if {[regexp {^file://(.*)} $porturl -> path]} {
if {[regexp $::macports::file_porturl_re $porturl -> path]} {
set realporturl "file://[file normalize $path]"
if {$porturl ne $realporturl} {
set porturl $realporturl
@@ -2394,6 +2403,7 @@ proc macports::getsourcepath {url} {
return [file join $portdbpath sources [lindex $source_path 3] [lindex $source_path 4] [lindex $source_path 5]]
}

set macports::source_is_snapshot_re {^((?:https?|ftp|rsync)://.+/)(.+\.(tar\.gz|tar\.bz2|tar))$}
##
# Checks whether a supplied source URL is for a snapshot tarball
# (private)
@@ -2407,7 +2417,7 @@ proc _source_is_snapshot {url {filename {}} {extension {}} {rooturl {}}} {
upvar $filename myfilename
upvar $extension myextension

if {[regexp {^((?:https?|ftp|rsync)://.+/)(.+\.(tar\.gz|tar\.bz2|tar))$} $url -> u f e]} {
if {[regexp $::macports::source_is_snapshot_re $url -> u f e]} {
set myrooturl $u
set myfilename $f
set myextension $e
@@ -5386,10 +5396,11 @@ proc macports::get_archive_sites_conf_values {} {
array set defaults $defaults_list
set conf_file ${macports_conf_path}/archive_sites.conf
set conf_options {applications_dir cxx_stdlib delete_la_files frameworks_dir name prefix type urls}
set line_re {^(\w+)([ \t]+(.*))?$}
if {[file isfile $conf_file]} {
set fd [open $conf_file r]
while {[gets $fd line] >= 0} {
if {[regexp {^(\w+)([ \t]+(.*))?$} $line match option ignore val] == 1} {
if {[regexp $line_re $line match option ignore val] == 1} {
if {$option in $conf_options} {
if {$option eq "name"} {
set cur_name $val
@@ -155,10 +155,10 @@ proc composite_version {version variations {emptyVersionOkay 0}} {
return $composite_version
}


set port_split_variants_re {([-+])([[:alpha:]_]+[\w\.]*)}
proc split_variants {variants} {
set result {}
set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
set l [regexp -all -inline -- $::port_split_variants_re $variants]
foreach { match sign variant } $l {
lappend result $variant $sign
}
@@ -1895,8 +1895,8 @@ proc action_log { action portlist opts } {
} else {
set prefix "\[a-z\]*"
}
set exp "^:($prefix|any):($phase|any) (.*)$"
foreach line $data {
set exp "^:($prefix|any):($phase|any) (.*)$"
if {[regexp $exp $line -> lpriority lphase lmsg] == 1} {
puts "[macports::ui_prefix_default $lpriority]$lmsg"
}
@@ -5553,10 +5553,11 @@ namespace eval portclient::questions {
set selected_opt []

set err_flag 1
set range_re {(\d+)-(\d+)}
foreach num $input {
if {[string is wideinteger -strict $num] && $num <= [llength $ports] && $num > 0} {
lappend selected_opt [expr {$num -1}]
} elseif {[regexp {(\d+)-(\d+)} $input _ start end]
} elseif {[regexp $range_re $input _ start end]
&& $start <= [llength $ports]
&& $start > 0
&& $end <= [llength $ports]
@@ -97,6 +97,7 @@ proc portfetch::mirror_sites {mirrors tag subdir mirrorfile} {
}

set ret [list]
set name_re {\$(?:name\y|\{name\})}
foreach element $portfetch::mirror_sites::sites($mirrors) {

# here we have the chance to take a look at tags, that possibly
@@ -113,7 +114,6 @@ proc portfetch::mirror_sites {mirrors tag subdir mirrorfile} {
set mirror_tag ""
}

set name_re {\$(?:name\y|\{name\})}
# if the URL has $name embedded, kill any mirror_tag that may have been added
# since a mirror_tag and $name are incompatible
if {[regexp $name_re $element]} {
@@ -153,6 +153,8 @@ proc portfetch::mirror_sites {mirrors tag subdir mirrorfile} {
proc portfetch::checksites {sitelists mirrorfile} {
global env
variable urlmap
set url_re {([a-zA-Z]+://.+)}
set tagged_url_re {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$}

foreach {listname extras} $sitelists {
upvar #0 $listname $listname
@@ -175,7 +177,7 @@ proc portfetch::checksites {sitelists mirrorfile} {

set site_list [list]
foreach site $full_list {
if {[regexp {([a-zA-Z]+://.+)} $site match site]} {
if {[regexp $url_re $site match site]} {
set site_list [concat $site_list $site]
} else {
set splitlist [split $site :]
@@ -194,7 +196,7 @@ proc portfetch::checksites {sitelists mirrorfile} {

# add in the global and user-defined mirrors for each tag
foreach site $site_list {
if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag] && ![info exists extras_added($tag)]} {
if {[regexp $tagged_url_re $site match site tag] && ![info exists extras_added($tag)]} {
if {$sglobal ne ""} {
set site_list [concat $site_list [mirror_sites $sglobal $tag "" $mirrorfile]]
}
@@ -206,7 +208,7 @@ proc portfetch::checksites {sitelists mirrorfile} {
}

foreach site $site_list {
if {[regexp {([a-zA-Z]+://.+/?):([0-9A-Za-z_-]+)$} $site match site tag]} {
if {[regexp $tagged_url_re $site match site tag]} {
lappend urlmap($tag) $site
} else {
lappend urlmap($listname) $site
@@ -220,6 +222,7 @@ proc portfetch::sortsites {urls default_listvar} {
global $default_listvar
upvar $urls fetch_urls
variable urlmap
set hostregex {[a-zA-Z]+://([a-zA-Z0-9\.\-_]+)}

foreach {url_var distfile} $fetch_urls {
if {![info exists urlmap($url_var)]} {
@@ -232,7 +235,6 @@ proc portfetch::sortsites {urls default_listvar} {
}
set urllist $urlmap($url_var)
set hosts {}
set hostregex {[a-zA-Z]+://([a-zA-Z0-9\.\-_]+)}

if {[llength $urllist] <= 1} {
# there is only one mirror, no need to ping or sort
@@ -207,25 +207,30 @@ proc portdestroot::destroot_finish {args} {
ui_info "$UI_PREFIX [format [msgcat::mc "Compressing man pages for %s"] ${subport}]"
set found 0
set manlinks [list]
set mandir_re {^(cat|man)(.)$}

foreach mandir [readdir "${manpath}"] {
if {![regexp {^(cat|man)(.)$} ${mandir} match ignore manindex]} { continue }
if {![regexp ${mandir_re} ${mandir} match ignore manindex]} { continue }
set gzfile_re "^(.*\[.\]${manindex}\[a-z\]*)\[.\]gz\$"
set bz2file_re "^(.*\[.\]${manindex}\[a-z\]*)\[.\]bz2\$"
set normalfile_re "\[.\]${manindex}\[a-z\]*\$"
set mandirpath [file join ${manpath} ${mandir}]
if {[file isdirectory ${mandirpath}] && [file type ${mandirpath}] eq "directory"} {
ui_debug "Scanning ${mandir}"
foreach manfile [readdir ${mandirpath}] {
set manfilepath [file join ${mandirpath} ${manfile}]
if {[file isfile ${manfilepath}] && [file type ${manfilepath}] eq "file"} {
if {[regexp "^(.*\[.\]${manindex}\[a-z\]*)\[.\]gz\$" ${manfile} gzfile manfile]} {
if {[regexp ${gzfile_re} ${manfile} gzfile manfile]} {
set found 1
system -W ${manpath} \
"$gunzip -f [file join ${mandir} ${gzfile}] && \
$gzip -9vnf [file join ${mandir} ${manfile}]"
} elseif {[regexp "^(.*\[.\]${manindex}\[a-z\]*)\[.\]bz2\$" ${manfile} bz2file manfile]} {
} elseif {[regexp ${bz2file_re} ${manfile} bz2file manfile]} {
set found 1
system -W ${manpath} \
"$bunzip2 -f [file join ${mandir} ${bz2file}] && \
$gzip -9vnf [file join ${mandir} ${manfile}]"
} elseif {[regexp "\[.\]${manindex}\[a-z\]*\$" ${manfile}]} {
} elseif {[regexp ${normalfile_re} ${manfile}]} {
set found 1
system -W ${manpath} \
"$gzip -9vnf [file join ${mandir} ${manfile}]"
@@ -248,11 +253,12 @@ proc portdestroot::destroot_finish {args} {
}
if {$found == 1} {
# check man page links and rename/repoint them if necessary
set gzext_re "\[.\]gz\$"
foreach manlink $manlinks {
set manlinkpath [file join $manpath $manlink]
# if link destination is not gzipped, check it
set manlinksrc [file readlink $manlinkpath]
if {![regexp "\[.\]gz\$" ${manlinksrc}]} {
if {![regexp ${gzext_re} ${manlinksrc}]} {
set mandir [file dirname $manlink]
set mandirpath [file join $manpath $mandir]
set pwd [pwd]
@@ -268,7 +274,7 @@ proc portdestroot::destroot_finish {args} {
# if gzipped destination exists, fix link
if {[file isfile ${mls_check}.gz]} {
# if actual link name does not end with gz, rename it
if {![regexp "\[.\]gz\$" ${manlink}]} {
if {![regexp ${gzext_re} ${manlink}]} {
ui_debug "renaming link: $manlink to ${manlink}.gz"
file rename $manlinkpath ${manlinkpath}.gz
set manlink ${manlink}.gz
@@ -773,10 +773,12 @@ proc platform {args} {
set os [lindex $args 0]
set args [lrange $args 1 [expr {$len - 2}]]

set release_re {(^[0-9]+$)}
set arch_re {([a-zA-Z0-9]*)}
foreach arg $args {
if {[regexp {(^[0-9]+$)} $arg match result]} {
if {[regexp $release_re $arg match result]} {
set release $result
} elseif {[regexp {([a-zA-Z0-9]*)} $arg match result]} {
} elseif {[regexp $arch_re $arg match result]} {
set arch $result
}
}
@@ -1794,9 +1796,10 @@ proc open_statefile {args} {
# $result, if any. Returns 1 if a line matched, 0 otherwise
proc get_statefile_value {class fd result} {
upvar $result upresult
set line_re "$class: (.*)"
seek $fd 0
while {[gets $fd line] >= 0} {
if {[regexp "$class: (.*)" $line match value]} {
if {[regexp $line_re $line match value]} {
set upresult $value
return 1
}
@@ -1861,13 +1864,15 @@ proc check_statefile_variants {variations oldvariations fd} {

set variants_found no
set targets_found no
set variant_re "variant: (.*)"
set target_re "target: .*"
seek $fd 0
while {[gets $fd line] >= 0} {
if {[regexp "variant: (.*)" $line match name]} {
if {[regexp $variant_re $line match name]} {
set upoldvariations([string range $name 1 end]) [string range $name 0 0]
set variants_found yes
}
if {[regexp "target: .*" $line]} {
if {[regexp $target_re $line]} {
set targets_found yes
}
}
@@ -2239,8 +2244,9 @@ proc handle_default_variants {option action {value ""}} {
set PortInfo(vinfo) {}
}
array set vinfo $PortInfo(vinfo)
set re {([-+])([-A-Za-z0-9_.]+)}
foreach v $value {
if {[regexp {([-+])([-A-Za-z0-9_.]+)} $v whole val variant]} {
if {[regexp $re $v whole val variant]} {
# Retrieve the information associated with this variant.
if {![info exists vinfo($variant)]} {
set vinfo($variant) {}
@@ -2307,8 +2313,9 @@ proc adduser {name args} {
set home /var/empty
set shell /usr/bin/false

set keyval_re {([a-z]*)=(.*)}
foreach arg $args {
if {[regexp {([a-z]*)=(.*)} $arg match key val]} {
if {[regexp $keyval_re $arg match key val]} {
set $key $val
}
}
@@ -2415,8 +2422,9 @@ proc addgroup {name args} {
set passwd {*}
set users ""

set keyval_re {([a-z]*)=(.*)}
foreach arg $args {
if {[regexp {([a-z]*)=(.*)} $arg match key val]} {
if {[regexp $keyval_re $arg match key val]} {
set $key $val
}
}
@@ -464,6 +464,7 @@ proc _activate_contents {port {rename_list {}}} {
set location [$port location]
set imagefiles [$port imagefiles]
set extracted_dir [extract_archive_to_tmpdir $location]
set replaced_by_re "(?i)^[$port name]\$"

set backups [list]
# This is big and hairy and probably could be done better.
@@ -493,7 +494,7 @@ proc _activate_contents {port {rename_list {}}} {
set result [mportlookup [$owner name]]
array unset portinfo
array set portinfo [lindex $result 1]
if {[info exists portinfo(replaced_by)] && [lsearch -regexp $portinfo(replaced_by) "(?i)^[$port name]\$"] != -1} {
if {[info exists portinfo(replaced_by)] && [lsearch -regexp $portinfo(replaced_by) $replaced_by_re] != -1} {
# we'll deactivate the owner later, but before activating our files
set todeactivate($owner) yes
set owner "replaced"

0 comments on commit b81bcbb

Please sign in to comment.
You can’t perform that action at this time.