delegates DNS and DHCP administration of some IPv4/v6 networks and domains to users. It is also the heart of a Network Information System.
| search (netmagis-2.3.5) | : | search (netmagis-2.3.6) |
|---|
| | |
| skipping to change at line 46 | | skipping to change at line 46 |
|---|
| | |
| # | | # |
| # Script parameters | | # Script parameters |
| # | | # |
| | |
| set conf(form) { | | set conf(form) { |
| {q 0 1 {}} | | {q 0 1 {}} |
| } | | } |
| | |
| # | | # |
|
| | # Valid query types |
| | # This list has the form {re1 type1 re2 type2 ...} |
| | # |
| | # Each re is matched against the query string (without selector). If |
| | # a match occurs, the search stops with the recognized type. |
| | # |
| | |
| | set retype { |
| | {^_$} myaddr |
| | {^\d+\.\d+\.\d+\.\d+$} inet |
| | {^\d+\.[\d.]*\*} inet |
| | {^([0-9a-f]{1,2}:){5}[0-9a-f]{1,2}$} mac |
| | {^[0-9a-f]{1,2}:[0-9a-f:]*\*} mac |
| | {^(([0-9a-f]{1,4}:){7,7}[0-9a-f]{1,4}|([0-9a-f]{1,4}:){1,7}:|([0-9a-f]{1,4}: |
| | ){1,6}:[0-9a-f]{1,4}|([0-9a-f]{1,4}:){1,5}(:[0-9a-f]{1,4}){1,2}|([0-9a-f]{1,4}:) |
| | {1,4}(:[0-9a-f]{1,4}){1,3}|([0-9a-f]{1,4}:){1,3}(:[0-9a-f]{1,4}){1,4}|([0-9a-f]{ |
| | 1,4}:){1,2}(:[0-9a-f]{1,4}){1,5}|[0-9a-f]{1,4}:((:[0-9a-f]{1,4}){1,6})|:((:[0-9a |
| | -f]{1,4}){1,7}|:)|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1 |
| | }[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-f]{1,4}:){1,4}:(( |
| | 25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1 |
| | }[0-9]))$} inet |
| | {^[0-9a-f]{4}:[0-9a-f:]*\*} inet |
| | {.} str |
| | } |
| | |
| | # |
| # Netmagis general library | | # Netmagis general library |
| # | | # |
| | |
| source %LIBNETMAGIS% | | source %LIBNETMAGIS% |
| | |
| # ::webapp::cgidebug ; exit | | # ::webapp::cgidebug ; exit |
| | |
| ############################################################################## | | ############################################################################## |
| # Utilities | | # Utilities |
| ############################################################################## | | ############################################################################## |
| | |
| skipping to change at line 72 | | skipping to change at line 91 |
|---|
| set result [::webapp::helem "font" $qmsg "color" "#FF0000"] | | set result [::webapp::helem "font" $qmsg "color" "#FF0000"] |
| d urlset "%URLFORM%" $conf(next) {} | | d urlset "%URLFORM%" $conf(next) {} |
| d result $conf(page) [list \ | | d result $conf(page) [list \ |
| [list %CRITERE% $qq] \ | | [list %CRITERE% $qq] \ |
| [list %RESULTAT% $result] \ | | [list %RESULTAT% $result] \ |
| ] | | ] |
| exit 0 | | exit 0 |
| } | | } |
| | |
| # | | # |
|
| | # Guess the type of the query |
| | # |
| | # Input: |
| | # - dbfd: database access |
| | # - q: user query (without selector) |
| | # Output: |
| | # - return value: guessed type or error |
| | # |
| | |
| | proc query-type {dbfd q} { |
| | global retype |
| | |
| | set r error |
| | foreach {re type} $retype { |
| | if {[regexp -nocase $re $q]} then { |
| | set r $type |
| | break |
| | } |
| | } |
| | return $r |
| | } |
| | |
| | # |
| # Parse a search query, which has the form | | # Parse a search query, which has the form |
| # [<sel>:]<val> | | # [<sel>:]<val> |
| # Examples: | | # Examples: |
|
| # 192.168.1.2 01 | | # 192.168.1.2 |
| # 01:02:03:04:05:06 | | # 01:02:03:04:05:06 |
| # www.example.com | | # www.example.com |
| # host: www | | # host: www |
| # net: lab | | # net: lab |
| # | | # |
| # Input: | | # Input: |
| # - dbfd: database access | | # - dbfd: database access |
| # - q: user query | | # - q: user query |
|
| # - _sel, _val, _type: see below | | # - _handlers, _val: see below |
| # Output: | | # Output: |
| # - return value: empty string or error message | | # - return value: empty string or error message |
|
| # - sel: list of selector procedures (see cgi-search-* procedures) | | # - handlers: list of selector procedures (see cgi-search-* procedures) |
| # - val: value to search | | # - val: value to search |
|
| # - type: detected value type (mac, inet, cidr or string) | | |
| # | | # |
| # History: | | # History: |
| # 2013/02/27: pda/jean : attempt to spec | | # 2013/02/27: pda/jean : attempt to spec |
| # 2013/03/06: pda/jean : design | | # 2013/03/06: pda/jean : design |
| # 2013/06/20: schplurtz : return more accurate search func list | | # 2013/06/20: schplurtz : return more accurate search func list |
|
| | # 2018/07/18: pda/jean : rewrite |
| # | | # |
| | |
|
| proc parse-query {dbfd q _sel _val _type} { | | proc parse-query {dbfd q _handlers _val} { |
| global conf | | global conf |
| | |
|
| upvar $_sel sel | | upvar $_handlers handlers |
| upvar $_val val | | upvar $_val val |
|
| upvar $_type type | | |
| set sel "" | | set sel "" |
| set val "" | | set val "" |
| set type "" | | set type "" |
| | |
|
| set matchproc * | | |
| set q [string trim $q] | | |
| # | | # |
|
| # Avoid case where the beginning of a MAC address is confused with | | # Gather available handlers (see cgi-search-* procs) |
| # an operator | | |
| # | | # |
|
| if {[regexp {^(([a-z]+):\s*)?(\S+)$} $q dum1 dum2 sel val]} then { | | |
| # nothing | | set lh {} |
| } elseif {[regexp {^\S+$} $q val]} then { | | foreach p [info procs cgi-search-*] { |
| set sel "" | | if {[regexp {^cgi-search-\d+-([^-]+)} $p dummy h]} then { |
| } else { | | # do not count host twice since there is both |
| return [mc "Invalid search query '%s'" $q] | | # cgi-search-xxx-host-str and ...-host-inet |
| } | | if {! ($h in $lh)} then { |
| if {$q eq "_"} then { | | lappend lh $h |
| set sel "myaddr" | | } |
| set val "_" | | |
| set type "" | | |
| set matchproc myaddr | | |
| } elseif {[string match "*:*" $q] } then { | | |
| if {[string match "group:*" $q]} then { | | |
| # nothing | | |
| } else { | | |
| set sel "" | | |
| set val $q | | |
| set type "mac" | | |
| set matchproc host | | |
| } | | } |
|
| } elseif {[string match "*.*" $q] } then { | | } |
| set sel "" | | |
| set val $q | | # |
| set type "inet" | | # First word in query is one of these selectors (i.e. handlers)? |
| set matchproc host | | # |
| set r "" | | |
| } elseif {[check-ip-syntax $dbfd $q "cidr"] eq ""} then { | | set resel [join $lh "|"] |
| set sel "" | | set resel "^(($resel):)?\\s*(\\S+)\\s*\$" |
| set val $q | | |
| set type "cidr" | | if {[regexp $resel $q dum1 dum2 sel val]} then { |
| set r "" | | |
| set matchproc cidr ; # cgi-search*cidr not yet implemented | | |
| } else { | | |
| # | | # |
|
| # Check operator and value | | # Valid query syntax (with or without a selector/handler). |
| | # Guess type of queried string |
| # | | # |
|
| | set type [query-type $dbfd $val] |
| | |
|
| | } else { |
| # | | # |
|
| # Recognize type | | # empty query, or query with spaces inside |
| # | | # |
|
| | | if {[string trim $q] eq ""} then { |
| if {[check-ip-syntax $dbfd $val "inet"] eq ""} then { | | set type "empty" |
| set type "inet" | | |
| set matchproc host | | |
| } elseif {[check-ip-syntax $dbfd $val "cidr"] eq ""} then { | | |
| set matchproc [set type "cidr"] | | |
| } else { | | } else { |
|
| set type "string" | | set type "error" |
| } | | } |
| } | | } |
| | |
|
| | if {$type eq "error"} then { |
| | return [mc "Invalid search query '%s'" $q] |
| | } |
| | |
| # | | # |
|
| # Verify operator/type compatibility | | # Determine which procs may handle this query |
| | # - sel = nature of objects to be searched for [host, group, etc.] |
| | # - type = guessed type of query [inet, str, inet, etc.] |
| # | | # |
| | |
| if {$sel eq ""} then { | | if {$sel eq ""} then { |
|
| set sel [lsort [info procs "cgi-search-*-$matchproc"]] | | set sel "*" |
| } else { | | } |
| set proc [info procs "cgi-search-*-$sel"] | | |
| if {$proc eq ""} then { | | set pattern "cgi-search-*-$sel-$type" |
| return [mc "Invalid search operator '%s'" $sel] | | set handlers [lsort [info procs $pattern]] |
| } | | if {[llength $handlers] == 0} then { |
| set sel [list $proc] | | return [mc "Invalid search query '%s'" $q] |
| } | | } |
| | |
| return "" | | return "" |
| } | | } |
| | |
|
| | # |
| | # Quote a string which may contain SQL special characters (%, _) |
| | # for LIKE operator |
| | # |
| | |
| | proc quote-escape {str} { |
| | set str [::pgsql::quote $str] |
| | regsub -all {[%_]} $str {\\&} str |
| | return $str |
| | } |
| | |
| | ############################################################################### |
| | # Display search results |
| | ############################################################################### |
| | |
| proc display-host {dbfd _trr idview q} { | | proc display-host {dbfd _trr idview q} { |
| upvar $_trr trr | | upvar $_trr trr |
| | |
| set rrtmpl { | | set rrtmpl { |
| allowed-groups {search {q group:%s}} | | allowed-groups {search {q group:%s}} |
| ip {edit {addr %1$s} {idview %2$s}} | | ip {edit {addr %1$s} {idview %2$s}} |
| } | | } |
| | |
| array set t $rrtmpl | | array set t $rrtmpl |
| lappend t(ip) {nextprog search} | | lappend t(ip) {nextprog search} |
| | |
| skipping to change at line 274 | | skipping to change at line 319 |
|---|
| } | | } |
| | |
| # Display aliased host | | # Display aliased host |
| lassign [display-rr-masked $dbfd trrh $idviewheb $rrtmpl] link desc | | lassign [display-rr-masked $dbfd trrh $idviewheb $rrtmpl] link desc |
| set title [mc {%1$s in view %2$s is a mail address hosted by %3$s in view %4
$s} $fqdn [u viewname $idview] $link [u viewname $idviewheb]] | | set title [mc {%1$s in view %2$s is a mail address hosted by %3$s in view %4
$s} $fqdn [u viewname $idview] $link [u viewname $idviewheb]] |
| | |
| return "$title $desc" | | return "$title $desc" |
| } | | } |
| | |
| ############################################################################## | | ############################################################################## |
|
| # Search cases | | # Search cases : my own address |
| ############################################################################## | | ############################################################################## |
| | |
|
| proc cgi-search-100-myaddr {dbfd q val type} { | | proc cgi-search-100-myaddr-myaddr {dbfd idgrp q val} { |
| global env | | global env |
| | |
| set lfound {} | | set lfound {} |
| if {[info exists env(REMOTE_ADDR)] && $val eq "_"} then { | | if {[info exists env(REMOTE_ADDR)] && $val eq "_"} then { |
| set val $env(REMOTE_ADDR) | | set val $env(REMOTE_ADDR) |
| foreach idview [u myviewids] { | | foreach idview [u myviewids] { |
| if {[read-rr-by-ip $dbfd $val $idview trr]} then { | | if {[read-rr-by-ip $dbfd $val $idview trr]} then { |
| lappend lfound [display-host $dbfd trr $idview $q] | | lappend lfound [display-host $dbfd trr $idview $q] |
| } | | } |
| } | | } |
| if {[llength $lfound] == 0} then { | | if {[llength $lfound] == 0} then { |
| lappend lfound [mc "Searched address: %s" $val] | | lappend lfound [mc "Searched address: %s" $val] |
| } | | } |
| } | | } |
| return $lfound | | return $lfound |
| } | | } |
| | |
|
| proc cgi-search-150-host {dbfd q val type} { | | ############################################################################## |
| set lfound {} | | # Search cases : host |
| | # |
| | # MAC and STR searches always use the 'LIKE' SQL operator. |
| | # For efficiency reasons, we try to perform a direct match (using '=' SQL |
| | # operator) for IP addresses only. |
| | ############################################################################## |
| | |
|
| switch $type { | | proc cgi-search-150-host-mac {dbfd idgrp q val} { |
| mac { | | # canonicalize MAC address for matching with ILIKE |
| # | | set l {} |
| # Attempt to search for the host. It if exists, trr will | | foreach byte [split $val ":"] { |
| # be filled. If it does not exists, trr will not be created. | | regsub -nocase {^[0-9a-f]$} $byte {0&} byte |
| # We don't test result, since existence of trr(idrr) will | | lappend l $byte |
| # suffice for next steps. | | } |
| # | | set qval [join $l ":"] |
| set newval [string map {* %} $val] | | |
| set sql "SELECT idrr FROM dns.rr | | set qval [quote-escape $qval] |
| WHERE mac::text LIKE '$newval' | | set qval [string map {* % ? _} $qval] |
| " | | set qval [string tolower $qval] |
| pg_select $dbfd $sql tab { | | set w "r.mac::text ILIKE '$qval'" |
| foreach idmac $tab(idrr) { | | return [host-search $dbfd $idgrp $q $w] |
| if {[read-rr-by-id $dbfd $idmac trr]} then { | | } |
| set lhost {} | | |
| foreach idview [u myviewids] { | | proc cgi-search-150-host-str {dbfd idgrp q val} { |
| if {[llength [rr-ip-by-view trr $idview]] > 0 | | set qval [quote-escape $val] |
| } then { | | set qval [string map {* % ? _} $qval] |
| lappend lhost $idview | | if {[string first "." $val] == -1} then { |
| break | | set w "r.name ILIKE '$qval'" |
| } | | } else { |
| } | | set w "r.name || '.' || d.name ILIKE '$qval'" |
| foreach idview $lhost { | | |
| lappend lfound [display-host $dbfd trr $i | | |
| dview $q] | | |
| } | | |
| } | | |
| } | | |
| } | | |
| } | | |
| inet { | | |
| # | | |
| # Attempt to search for the host. It if exists, trr will | | |
| # be filled. If it does not exists, trr will not be created. | | |
| # We don't test result, since existence of trr(idrr) will | | |
| # suffice for next steps. | | |
| set newval [string map {* %} $val] | | |
| if {$newval ne $val} then { | | |
| foreach idview [u myviewids] { | | |
| set sql "SELECT i.idrr FROM dns.rr_ip i, dns.rr | | |
| r WHERE i.idrr = r.idrr AND i.addr::text LIKE '$newval' AND r.idview = $idview" | | |
| pg_select $dbfd $sql tab { | | |
| foreach idip $tab(idrr) { | | |
| if {[read-rr-by-id $dbfd $idip tr | | |
| r]} then { | | |
| lappend lfound [display-host | | |
| $dbfd trr $idview $q] | | |
| } | | |
| } | | |
| } | | |
| } | | |
| } else { | | |
| foreach idview [u myviewids] { | | |
| set sql "SELECT i.idrr FROM dns.rr_ip i, dns.rr | | |
| r WHERE i.idrr = r.idrr AND i.addr='$newval' AND r.idview = $idview" | | |
| pg_select $dbfd $sql tab { | | |
| foreach idip $tab(idrr) { | | |
| if {[read-rr-by-id $dbfd $idip tr | | |
| r]} then { | | |
| lappend lfound [display-host | | |
| $dbfd trr $idview $q] | | |
| } | | |
| } | | |
| } | | |
| } | | |
| } | | |
| } | | |
| cidr { | | |
| } | | |
| string { | | |
| set ldom [u myiddom] | | |
| set name $val | | |
| set newval [string map {* %} $val] | | |
| foreach iddom $ldom { | | |
| foreach idview [u myviewids] { | | |
| #puts($idview) | | |
| set sql "SELECT idrr FROM dns.rr WHERE name::text LIKE '$newva | | |
| l' AND iddom = $iddom AND idview = $idview" | | |
| pg_select $dbfd $sql tab { | | |
| set idrr $tab(idrr) | | |
| #puts($idrr) | | |
| foreach idname $tab(idrr) { | | |
| if {[read-rr-by-id $dbfd $idname trr]} t | | |
| hen { | | |
| #puts("$trr(name).$trr(domain)") | | |
| | |
| if {[llength [rr-ip-by-view trr $idview | | |
| ]] > 0} then { | | |
| lappend lfound [display-host $dbfd t | | |
| rr $idview $q] | | |
| } | | |
| if {[rr-cname-by-view trr $idview] ne "" | | |
| } then { | | |
| lappend lfound [display-alias $dbfd t | | |
| rr $idview $q] | | |
| } | | |
| if {[rr-mx-by-view trr $idview] ne ""} th | | |
| en { | | |
| foreach l [display-all-mx $dbfd trr $ | | |
| idview $q] { | | |
| lappend lfound $l | | |
| } | | |
| } | | |
| | |
| } | | |
| } | | |
| } | | |
| | |
| } | | |
| | |
| # | | |
| # if {[rr-cname-by-view trr $idview] ne ""} then { | | |
| # lappend lfound [display-alias $dbfd trr $idview $q] | | |
| # } | | |
| # if {[rr-mx-by-view trr $idview] ne ""} then { | | |
| # foreach l [display-all-mx $dbfd trr $idview $q] { | | |
| # lappend lfound $l | | |
| # } | | |
| # } | | |
| } | | |
| } | | |
| default { | | |
| d error [mc "Internal error: unknown type"] | | |
| } | | |
| } | | } |
|
| | | return [host-search $dbfd $idgrp $q $w] |
| return $lfound | | |
| } | | } |
| | |
|
| proc cgi-search-160-mailrole {dbfd q val type} { | | proc host-search {dbfd idgrp q w} { |
| set lfound {} | | set lfound {} |
|
| switch $type { | | set sql "SELECT r.idrr |
| string { | | FROM dns.rr r |
| if {[regexp {^[^.]+\..+$} $val]} then { | | INNER JOIN dns.domain d USING (iddom) |
| # | | INNER JOIN dns.p_dom pd USING (iddom) |
| # Name and domain | | INNER JOIN dns.p_view pv USING (idview) |
| # | | WHERE $w |
| set msg [check-fqdn-syntax $dbfd $val name domain iddom] | | AND pd.idgrp = $idgrp |
| if {$msg ne ""} then { | | AND pv.idgrp = $idgrp |
| # display-message $val $msg | | " |
| } | | pg_select $dbfd $sql tab { |
| set ldom [list $iddom] | | set idrr $tab(idrr) |
| } else { | | if {[read-rr-by-id $dbfd $idrr trr]} then { |
| set msg [check-name-syntax $val] | | set idview $trr(idview) |
| if {$msg ne ""} then { | | if {[llength [rr-ip-by-view trr $idview]] > 0} then { |
| # display-message $val $msg | | lappend lfound [display-host $dbfd trr $idview $q] |
| } | | |
| set ldom [u myiddom] | | |
| set name $val | | |
| } | | } |
|
| | | if {[rr-cname-by-view trr $idview] ne ""} then { |
| foreach iddom $ldom { | | lappend lfound [display-alias $dbfd trr $idview $q] |
| foreach idview [u myviewids] { | | } |
| if {[read-rr-by-name $dbfd $name $iddom $idview trr]} then { | | if {[rr-mx-by-view trr $idview] ne ""} then { |
| set rm [rr-mailrole-by-view trr $idview] | | foreach l [display-all-mx $dbfd trr $idview $q] { |
| if {[llength $rm] > 0} then { | | lappend lfound $l |
| lappend lfound [display-mailrole $dbfd trr $idview $q | | |
| ] | | |
| } | | |
| } | | |
| } | | } |
| } | | } |
|
| } | | set rm [rr-mailrole-by-view trr $idview] |
| mac - | | if {[llength $rm] > 0} then { |
| inet - | | lappend lfound [display-mailrole $dbfd trr $idview $q] |
| cidr { | | } |
| d error [mc "Invalid search query '%s'" $q] | | |
| } | | |
| default { | | |
| d error [mc "Internal error: unknown type"] | | |
| } | | } |
| } | | } |
|
| | | |
| return $lfound | | return $lfound |
| } | | } |
| | |
|
| proc cgi-search-400-group {dbfd q val type} { | | proc cgi-search-150-host-inet {dbfd idgrp q val} { |
| set lfound {} | | set qval [quote-escape $val] |
| | set qval [string map {* % ? _} $qval] |
| | if {[check-ip-syntax $dbfd $val "inet"] eq ""} then { |
| | set w "i.addr = '$qval'" |
| | } else { |
| | set w "host (i.addr)::text ILIKE '$qval'" |
| | } |
| | |
|
| set idgrp [u groupid $val] | | set sql "SELECT DISTINCT (r.idrr) |
| if {$idgrp ne ""} then { | | FROM dns.rr r |
| # | | NATURAL JOIN dns.rr_ip i |
| # Get all login names for this group | | INNER JOIN dns.domain d USING (iddom) |
| # | | INNER JOIN dns.p_dom pd USING (iddom) |
| set lcor {} | | INNER JOIN dns.p_view pv USING (idview) |
| set sql "SELECT login FROM global.nmuser | | WHERE $w |
| WHERE idgrp = $idgrp | | AND pd.idgrp = $idgrp |
| ORDER BY login" | | AND pv.idgrp = $idgrp |
| pg_select $dbfd $sql tab { | | AND dns.check_ip_grp (i.addr, $idgrp) |
| lappend lcor $tab(login) | | " |
| | set lfound {} |
| | pg_select $dbfd $sql tab { |
| | if {[read-rr-by-id $dbfd $tab(idrr) trr]} then { |
| | lappend lfound [display-host $dbfd trr $trr(idview) $q] |
| } | | } |
|
| | } |
| | return $lfound |
| | } |
| | |
| | ############################################################################## |
| | # Search cases : group |
| | ############################################################################## |
| | |
|
| | proc cgi-search-400-group-str {dbfd idgrp q val} { |
| | set lfound {} |
| | |
| | set qval [quote-escape $val] |
| | set qval [string map {* % ? _} $qval] |
| | set sql "SELECT g.name, g.idgrp, string_agg (u.login, ' ') AS members |
| | FROM global.nmgroup g |
| | NATURAL INNER JOIN global.nmuser u |
| | WHERE g.name ILIKE '$qval' |
| | GROUP BY g.name, g.idgrp |
| | " |
| | pg_select $dbfd $sql tab { |
| h mask-next | | h mask-next |
|
| set link [h mask-link $val] | | set link [h mask-link $tab(name)] |
| set title [mc "%s is a Netmagis group" $link] | | set title [mc "%s is a Netmagis group" $link] |
| | |
|
| | # let's pray for not having Tcl special characters in login names |
| | set lcor [split $tab(members) " "] |
| | |
| # members of the group | | # members of the group |
| if {[llength $lcor] == 0} then { | | if {[llength $lcor] == 0} then { |
| set desc [mc "Empty group (no user)"] | | set desc [mc "Empty group (no user)"] |
| } else { | | } else { |
| set desc "" | | set desc "" |
| foreach login $lcor { | | foreach login $lcor { |
| set n [read-user $dbfd $login tabuid msg] | | set n [read-user $dbfd $login tabuid msg] |
| if {$n != 1} then { | | if {$n != 1} then { |
| d error $msg | | d error $msg |
| } | | } |
| | |
| skipping to change at line 523 | | skipping to change at line 507 |
|---|
| ############################################################################## | | ############################################################################## |
| | |
| d cgi-register {q .+} {} { | | d cgi-register {q .+} {} { |
| global conf | | global conf |
| global env | | global env |
| | |
| # | | # |
| # Parse query, check consistancy and deduce search cases | | # Parse query, check consistancy and deduce search cases |
| # | | # |
| | |
|
| set msg [parse-query $dbfd $q sel val type] | | set msg [parse-query $dbfd $q handlers val] |
| if {$msg ne ""} then { | | if {$msg ne ""} then { |
| display-message $q $msg | | display-message $q $msg |
| } | | } |
| | |
| # | | # |
| # Loop through all possible search cases | | # Loop through all possible search cases |
| # | | # |
| | |
|
| | set idgrp $tabuid(idgrp) |
| set lfound {} | | set lfound {} |
|
| foreach s $sel { | | foreach h $handlers { |
| set lfound [concat $lfound [$s $dbfd $q $val $type]] | | set lfound [concat $lfound [$h $dbfd $idgrp $q $val]] |
| } | | } |
| | |
| # | | # |
| # Did we find something? | | # Did we find something? |
| # | | # |
| | |
| if {[llength $lfound] == 0} then { | | if {[llength $lfound] == 0} then { |
| display-message $val [mc "String '%s' not found" $val] | | display-message $val [mc "String '%s' not found" $val] |
| } | | } |
| | |
| | |
| skipping to change at line 563 | | skipping to change at line 548 |
|---|
| } | | } |
| set result [::webapp::helem "ul" $html] | | set result [::webapp::helem "ul" $html] |
| | |
| # | | # |
| # Cosmetic clean-up | | # Cosmetic clean-up |
| # | | # |
| | |
| if {$q eq "_"} then { | | if {$q eq "_"} then { |
| set q "" | | set q "" |
| } else { | | } else { |
|
| set q [::webapp::post-string $q] | | set q [::webapp::html-string $q] |
| } | | } |
| | |
| # | | # |
| # End of script: output page and close database | | # End of script: output page and close database |
| # | | # |
| | |
| d urlset "%URLFORM%" $conf(next) {} | | d urlset "%URLFORM%" $conf(next) {} |
| d result $conf(page) [list \ | | d result $conf(page) [list \ |
| [list %CRITERE% $q] \ | | [list %CRITERE% $q] \ |
| [list %RESULTAT% $result] \ | | [list %RESULTAT% $result] \ |
| | | |
| End of changes. 44 change blocks. |
|---|
| 248 lines changed or deleted | | 223 lines changed or added |
|---|
"Fossies" - the Fresh Open Source Software Archive 