#
# <20180704.1714.44>
#
# A find routine much like the file 'find' routine but for
# the registry.

# ::realfind::realFind basedir filterList ?incremental-Call-Back?
# 
# 'filterList' is a list of filters of the sort found in the *nix find man page
# At this time the following are available:
#
# -L This controls if a link is to be followed (default is no).        

# options: (always checked before tests) -maxdepth <int>, -mindepth <int>

# tests: (these are used to form an expression)

# these are objects found in the scan:
# -path  is the string of -keys seperated with "/"s starting with the keys found
#        in the current location (where the scan started)
# -key   refers to the last element in the path (think of it as the last directory)
#        -key and -path are NOT case sensitive
# -value refers name of the element found at the -path location
# -type  refers to the type of the -value element
#        valid types are:
#        binary           arbitary binary data *
#        none             arbitary binary data with no defined type *
#        sz               string
#        expand_sz        string with unexpanded references to env variables (%PATH%)
#        dword            little-endian 32-bit number
#        dword_big_endian big-endian 32-bit number
#        link             symbolic link *
#        multi_sz         array of strings
#        resource_list    device-driver resource list *
#     * indicates types that may have embedded nulls
# -data  is the data named -value and is of type -type

# These refer to (during the scan) the current value of the last key, value, type & data
# -path refers to the whole path (from  the path at the start to the current location in 
# the scan. For example if a search is started at:
# "local/HKEY_LOCAL_MACHIN/SOFTWARE" the -path would start at "" and grow as the scan
# moved deeper into the registry. All found entities would be under
# "local/HKEY_LOCAL_MACHIN/SOFTWARE"

# Constants and patterns used in expressions:

# -empty -true -false 
#
# These can also be expressed as
# "" or {}, 1 and 0 respectively.

# Registry options: -key -value -type -data
#             Keys are case insensitive, values 
# Operators:  ( expr )  ! expr  -not expr expr1 expr2 expr1 -a expr2 expr1 -and expr2
#             expr1 -o expr2 expr1 -or expr2 
#             Note that -o and -or are the same and that -a, -and and " " are the same
#
# Expressions: Expressions are built using "Operators" and "Operands". An expression 
#              result is either true or false. 
#              Unary Operators:
#              ! -not
#              -nc     (no case, compares ignor case)

#              Binary operators:
#              -regex (pattern and one of -key, -value, -type -data)
#              -o or -or        (logical or)
#              -a -and, and " " (logical and)
#              -x or -xor       (logical exclusive or)
#              == or -is        (equal (string compare unless both numeric))
#              !=               (not equal)
#              ( and )          (with space separators, grouping as in math)
#              {     }          (a list of possibilities for -in or -ni)
#              -in              (first operand is "in" second grouping)
#              -ni              (first operand is "notin" second grouping)

# -regex, ==, !=, expect string operands. The first operand is taken as a pattern
# and matched against the second operand. String match is used and allows wild cards
# *, ?, and []. These patterns should be enclosed in "" or {}, especially if they
# contain spaces, $, or "\". The general syntax is:
#
# <pattern> opcode {-nc} <second operand>
#
# Where opcode is one of -regex, == or != and -nc is optional no case modifier.
# <second operand> should be one of -key, -path, -value, -type or -data
# (keys and path are always compared with out case so -nc is redundant in this case)

# -in and -ni operators differ in that the syntax is:

# <operand> opcode <list>
#
# Where <operand> is one of -key, -path, -value, -type or -data
# opcode is -in or -ni (in or not in)
# and <list> is a list of possible values
# This is most use full to test -type e.g. -type -in {sz expand_sz}
# The format for <list> is e.g. {sz expand_sz}
# This test is always case sensitive (i.e. -nc can not be used here)

#              
#              
#


# package provide regfind 15.10

namespace eval ::regfind {
  namespace export realFinc
}

proc ::regfind::getOp {start line} {
  upvar $start begin
  set end [stringGetToken $line begin]
  set rt [string range $line $begin $end]
  set begin [incr end]
  return $rt
}

# Here we process the filter list to build the expression we will
# evaluate for each possible found entry
# This code treats the filterList as a string NOT alist

proc ::regfind::buildExp {filterList} {
  # puts "$filterList"
  # build and parse the options and expression
  set openP 0
  set expAnd 0
  set expOr  0
  set state 1
  set exp {}
  #
  # Lets make sure we have all the white space we need
  #
  set filterList [regsub -all {\(|\)|,|!|==|!=} $filterList { \0 }]
  # Replace the ()'s around ni/in groups
  # set filterList [regsub -all {\((( *[^( )]+ *,){1,} *[^( )]+ *)\)} $filterList {{\1}}]
  puts "$filterList"
  set start 0
  while {[set expOp [getOp start $filterList]] != {}} {
    #set start $end
    set inGroup 0
    switch -exact $expOp {
      \(  -
      \)  {
      	incr openP [expr {$expOp == "(" ? 1 : -1}]
	#if {$expOp == ")" && $state != 3} {error "Negate followed by \)"}
	if {$expOp == "("} {set $state 1}
	append exp "$expOp "
      }
      -regex  {append exp "regexp "}
      !=      -
      ==      -
      in      -
      ni      {append exp "$expOp "}
      -is     {append exp "== "}
      -true   {append exp "1 "}
      -false  {append exp "0 "}
      -empty  {append exp "{} "}
      -path   {append exp {$path }}
      -key    -
      -value  -
      -type   -
      -data   {append exp "[string replace $expOp 0 0 \$] "}
      -not    {append exp "! "}
      -x      -
      -xor    {append exp "^ "}
      -o      -
      -or     {append exp "| "}
      -a      -
      -and    {append exp "& "}
      default {puts "default pass $expOp";append exp "$expOp "}
    }
  }
  if {$openP != 0} {error "Missed matched parentheses."}

  # now fix up the binary ops to do the proper function calls
  # we expect "pattern" {-nc}  op "operand"
  # where "pattern" is simple, i.e. one list element
  #       "op"      is one of {!= == regex in ni}
  #       "operand" is simple unless it starts with "\{"
  set result {}
  set start 0
  set old ""
  puts "exp is $exp"
  while {[set term [getOp start $exp]] != {}} {
    set new {}
    set ncFlag 0
    switch -exact $term {
      regex {set new "\[regex "}
      !=    {set new "!\[string match "}
      ==    {set new "\[string match "}
      in    -
      ni    {set new "$term"}
      default {
	append result "$old "
	set old "$term"}
    }
    if {$new != {}} {
      # fetch the next item
      
      if {[set nx [getOp start $exp]] == "-nc"} {
	if {$new in {in ni}} {
	  return -code error "Don't understand \"-nc\" with opcode \"$new\""
	}
	set nx [getOp start $exp]
	set ncFlag 1
	# append new "-nocase "
      }
      if {$ncFlag || $nx in {$key $path $value}} {
	append new "-nocase "
      }
      
      # nx is the next term in the input string,
      # old is the term prior to the opcode
      if {$new ni {in ni}} {
	# Sort out the order. Pattern goes first. Easy if one of them is
	# a $var, otherwise assume presentation order
	frputs new old nx
	if {[string index $old 0] == "\$"} {
	  append result "$new\"$nx\" "
	  append result "$old \] "
	} else {
	  append result "$new\"$old\" "
	  append result "$nx \] "
	}
	set old ""
      } else {
	append result "\"$old\" $new "
	set old {}
	# This is the in/ni so the second op may have more than one element
	if {$nx == {\{} } {
	  while {$nx != {\}}} {
	    append result "$nx "
	    set nx [getOp start $exp]
	  }
	}
	append result  "$nx "
      }
    }
  }
  append result $old
  return $result
}

# here we put up a query window to get the find info.
proc ::regfind::buildWindow {inst} {
  global config glob
  variable expression  {  == -key}
  variable followLinks {0}
  variable minDepth    {0}
  variable maxDepth    {1000}

  set smart_buts \
      [list \
	   [list [_ "expression:"] {-textvariable ::regfind::expression}]\
	   [list [_ "follow links"] {-variable ::regfind::followLinks}]\
	   [list [_ "minimum depth:"] {-textvariable ::regfind::minDepth}]\
	   [list [_ "maximum depth:"] {-textvariable ::regfind::maxDepth}]\
	   [_ OK] [_ Cancel]]
  set ops [list maxw [expr {100 * [font measure $glob(gui,ListBoxFont) {0}]}]]

  set title [_ "Registry Find..."]
  set startMes [list {} [_ "This command searches from the current location (%s)\
                and below for registry entries that match the expression\
                you enter here.\n\nThe registry \"path\" consists of \"keys\" joined\
                together with \"/\" characters. In the expression you enter below\
                \"-key\" refers to the last \"key\" in the \"path\" while \"-path\"\
                refers to the path from the current location down.\nAt the end of a\
                \"path\" there may be additional \"keys\" and or \"values\"\
                (some what like file names). Each \"value\" has a name, a type\
                and data. You may refer to each of these in the expression as \
                \"-value\", \"-type\" and \"-data\"\nThere are two sorts of \"patterns\":\
                regular expression patterns and \"glob\" patterns (where \"*\"\
                is any string including the nul string an \"?\" refers to any\
                single character, and \"\[chars]\" matches any character in\
                chars).\n\nThe Unary operators are:\n\"!\" and \"-not\"\n\nThe modifier\
                is:\n\"-nc\" or \"-nocase\" which should appear after \"-regex\",\
                \"==\", \"-is\" or \"!=\" to force the test to be no-case. Keys and\
                Values are always no-case so this is only useful with \"-data\".\n\nThe\
                binary operators are:\n\"-regex\"\n\"-o\",\"-or\" and \"|\" (or)\n\"-a\",\
                \"-and\" (and)\n\"-x\", \"-xor\" (exclusive or)\n\"==\" or \"-is\"\
                (equal)\n\"!=\" (not equal)\n\"-in\", \"-ni\"\
                (in or not in a group)\n\nA group (for use with \"-in\" or \"-ni\"\
                is defined by curly braces (\{ \}) enclosing one or more\
                strings\nParentheses may be used as in normal expressions.\n\nIn\
                addition the following constants are defined:\n \"-empty\"\
                \"-true\" and \"-false\" (these may also be coded as \"{}\", \"1\"\
                and \"0\".\n\nType (\"-type\") will be one\
                of:\nbinary           arbitary binary data\
                  *\nnone             arbitary binary data with no defined type\
                  *\nsz              \
             string\nexpand_sz        string with unexpanded references to env variables\
           (%%PATH%%)\ndword            little-endian 32-bit\
             number\ndword_big_endian big-endian 32-bit\
             number\nlink             symbolic link\
                  *\nmulti_sz         array of\
            strings\nresource_list    device-driver resource list\
            *\n * indicates types that may have embedded nulls\n\nThe following\
                controls are also allowed:\n\"follow\
                symbolic links\"\n\"mindepth <n>\" (only test and report if\
                at least <n> down\
                in the \"key\" tree)\n\"maxdepth <n>\" (only test and report if depth\
                is less than or equal to <n> in the \"key\" tree)\n\nExamples:\n*foo*\
                 == -key                      (find all keys with \"foo\"\
                in the name)\n*foo*\
                 == -key -and *new* == -value (find all keys with \"foo\" in the\
                 name that have values with \"new\" in the values name.\
                " $glob($inst,pwd)]]

  set butCount [llength $smart_buts]

  set r [smart_dialog ".dbl_entry_dialog" "."  $title\
	     $startMes \
	     -1 $butCount\
	     $smart_buts [buildDialogConfig] $ops]

  if {$r == -1 || $r == ($butCount - 1)} {return}

  set exp [buildExp $expression]
  if {$exp == {}} {
    set exp 1
  }

  # We borrow some code from the file find...
  #
  set w [FindDialog $inst "$exp"]
  set geo [buildStop $w \
	       [_ "Searching, %s for %s. Please wait..." "$::glob($inst,pwd)/*" "$exp" ] \
	       "set ::regfind::findStop$w" 1]
  after idle [list ::regfind::FindAsyncHandler $inst $w $exp]
}

proc ::regfind::FindAsyncHandler {inst w exp} {
  variable followLinks
  variable minDepth
  variable maxDepth
  set parms [list -1 $::glob($inst,pwd)]
  # first remove the >2 stuff
  # if {[lindex $cmds end-1] == ">2"} {set cmds [lreplace $cmds end-1 end]}
  set ::regfind::findStop$w 0
  set r [catch {::regfind::search $inst $w $exp} what]
  if {$r !=0} {
    #puts "rtn $what"
    findData $parms $w d data " ${what}\n"
    findData $parms $w d data " $::errorInfo"
  } else {
    #puts "rtn 0 $what"
    foreach line $what {
      findData $parms $w d data " $line"
    }
  }
  findData $parms $w d eof
  unset regfind::findStop$w
  
}

proc ::regfind::FindDialog {inst pat} {
  # we use a special version of viewstring where we provide the call 
  # to the string search...
  #set result [join [lsort $result] "\n"]
  set result ""
  return [ViewString \
	      [_ "Find %s in %s Click on entry to display in panel" \
		   $pat "$::glob($inst,pwd)/*" ] \
	      result SearchConfig [list FindConfig $inst]]
}

proc ::regfind::breathe {} {
  after idle [list after 0 [list incr ::regfind::air]]
  vwait ::regfind::air
}


# Here is the search code
proc ::regfind::search {inst w exp} {
  variable followLinks
  variable minDepth
  variable maxDepth

  # If the expression does not reference value, type or data we will
  # only look at keys...
  set all [expr {[string match {*$value*} $exp] ||\
		     [string match {*$type*} $exp] ||\
		     [string match {*$data*}  $exp]}]
  set depth 0
  set base $::glob($inst,pwd)
  set parm [list -1 $base]
  set here $base
  set leftToVisit {{}}
  frputs exp
  # Lets avoid recursion here.
  while {$leftToVisit != {} } {
    set  path [lindex $leftToVisit end]
    breathe
    if {[info exists ::regfind::findStop$w] && [set ::regfind::findStop$w] != 0} {
      error "User stop requested at $path"
    }
    set leftToVisit [lrange $leftToVisit 0 end-1]
    set r [catch {VFSregistry::REGISTRYlistF $base/$path} keyList]
    if {$r != 0} {
      if {[string match -nocase "*access*" $keyList]} {
	# We note access issues and continue
	findData $parm $w {} "data" "$path/ error: $keyList\n"
	continue
      } else {
	PopError "Failed list with: $keyList"
	return -code error $keyList
      }
    }
    foreach ent $keyList {
      # frputs ent keyList
      array set vals {file {} type {} link {} flags {}}
      array set vals $ent
      set key $vals(file)
      if {$vals(type) == "d"} {
	if {!$all && $depth >= $minDepth && [expr $exp]} {
	  # frputs exp key "[expr $exp] "
	  findData $parm $w {} "data" $path/$key\n
	  breathe
	}
	if {$depth < $maxDepth} {
	  set where [expr {$path == {} ? "$key" : "$path/$key"}]
	  frputs where leftToVisit
	  if {$where ni $leftToVisit} {
	    lappend leftToVisit $where
	  }
	}
      } elseif {$all && $depth >= $minDepth} {
	set type $vals(flags)
	# We put value back to original (with back and forward slashes)
	set mungValue $key
	
	set value [regsub -all $::optionalSlass $key {/}]
	set value [regsub -all $::optionalBackSlass $value {\\}]
	set key [file tail $key]
	set data $vals(link)
	if {[expr $exp]} {
	  findData $parm $w {} "data" $path/$mungValue\n
	  breathe
	}
      }
    }
  }
}
