Tcl Library Source Code

# cfront.tcl --
#
#	Generator frontend for compiler of magic(5) files into recognizers
#	based on the 'rtcore'. Parses magic(5) into a basic 'script'.
#
# Copyright (c) 2016      Poor Yorick     <[email protected]>
# Copyright (c) 2004-2005 Colin McCormack <[email protected]>
# Copyright (c) 2005      Andreas Kupries <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: cfront.tcl,v 1.7 2008/03/22 01:10:32 andreas_kupries Exp $

package require Tcl 8.4

# file to compile the magic file from magic(5) into a tcl program
package require fileutil              ; # File processing (input)
package require fileutil::magic::cgen ; # Code generator.
package require fileutil::magic::rt   ; # Runtime (typemap)
package require struct::list          ; # lrepeat.
package require struct::tree          ; #

package provide fileutil::magic::cfront 1.0
package provide fileutil::magic::cfront 1.2

# ### ### ### ######### ######### #########
## Implementation

namespace eval ::fileutil::magic::cfront {
    # Configuration flag. (De)activate debugging output.
    # This is done during initialization.
    # Changes at runtime have no effect.

    variable debug 0

    # Make backend functionality accessible
    namespace import ::fileutil::magic::cgen
    # Constants

    namespace export compile generate install

    variable floattestops {= < > !}
    variable inttestops {= < > & ^ ~ !}
    variable stringtestops { > < = !}
    variable offsetopts {& | ^ + - * / %}
    variable stringmodifiers {W w c C t b T}
    variable typemodifiers [dict create \
	indirect r \
	search $stringmodifiers \
	string $stringmodifiers \
	pstring [list {*}$stringmodifiers B H h L l J] \
	regex {c s l} \
    ]
    set numeric_modifier_allowed {regex search}
    variable hashprotection  [list "\#" "\\#" \" \\\" \{ \\\{ \} \\\}]      ;#"
    variable hashprotectionB [list "\#" "\\\#" \" \\\" \} \\\} ( \\( ) \\)] ;#"
	
    variable types_numeric_short { 
	dC byte d1 byte C byte 1 byte ds short d2 short S short 2 short dI long
	dL long d4 long I long L long 4 long  d8 quad 8 quad dQ quad Q quad
    }

    variable types_numeric_re [join [list {*}[
	array names ::fileutil::magic::rt::typemap] {*}[
	dict keys $types_numeric_short]] |]

    variable types_string_short [dict create s string] 
    # Make backend functionality accessible
    namespace import ::fileutil::magic::cgen::*

    namespace export compile procdef install

    variable types_string {
	bestring clear default indirect lestring pstring regex search string
    }
    variable types_string_re [join [list {*}[
	dict keys $types_string_short] {*}$types_string] |]

    variable types_verbatim {name use}

    variable types_notimplemented {}
    variable types_notimplemented_re [join $types_notimplemented |]

    variable types_numeric_real {
	float double befloat bedouble lefloat ledouble
    }

    variable indir_typemap [dict create \
	b byte c byte e ledouble f ledouble g ledouble i leid3 h leshort \
	s leshort l lelong B byte C byte E bedouble F bedouble G bedouble \
	H beshort I beid3 L belong m ME S beshort]

}

proc ::fileutil::magic::cfront::advance {len args} {
    upvar node node tree tree
    if {[llength args]} {
	upvar [lindex $args 0] res
    }
    set res {}
    set line [$tree get $node line]
    set cursor [$tree get $node cursor]
    if {[string index $len 0] eq {w}} {
	regexp -start $cursor {\A(\s*)} $line match res
	incr cursor [string length $match]
	set len [string range $len 1 end]
    }
    if {$len ne {}} {
	if {[regexp -start $cursor "\\A(.{[
	    scan $len %lld]})" $line match res]} {
	    incr cursor [string length $match]
	}
    }
    set line [$tree get $node line]
    $tree set $node cursor $cursor
    return $res
}

proc ::fileutil::magic::cfront::rewind len {
    upvar node node tree tree
    set cursor [$tree get $node cursor]
    incr cursor -$len
    $tree set $node cursor $cursor
}

proc ::fileutil::magic::cfront::parseerror args {
    upvar node node tree tree
    set cursor [$tree get $node cursor]
    set line [$tree get $node line]
    set files [$tree get root files]
    set file [lindex files [$tree get $node file]]
    return -code error -errorcode [list fumagic {parse error}] [
	list [lmap arg $args {string trim $arg}] \
	file $file \
	linenenum [$tree get $node linenum] \
	cursor $cursor \
	line [list \
	    [string range $line 0 ${cursor}-1] \
	    [string range $line $cursor end]]]
}

proc ::fileutil::magic::cfront::parsewarning args {
    upvar node node tree tree
    catch {parseerror {*}$args} res options
    puts stderr [dict get $options -errorinfo]
}


# parse an individual line
proc ::fileutil::magic::cfront::parseline {line {maxlevel 10000}} {
variable ::fileutil::magic::cfront::parsedkeys {
    # calculate the line's level
    set unlevel [string trimleft $line >]
    set level   [expr {[string length $line] - [string length $unlevel]}]
    if {$level > $maxlevel} {
   	return -code continue "Skip - too high a level"
    }

}
proc ::fileutil::magic::cfront::parseline {tree node} {
    # regexp parse line into (offset, type, value, command)
    set parse [regexp -expanded -inline {^(\S+)\s+(\S+)\s*((\S|(\B\s))*)\s*(.*)$} $unlevel]
    if {$parse == {}} {
    variable parsedkeys
   	error "Can't parse: '$unlevel'"
    }

    set line [$tree get $node line]
    # unpack parsed line
    set value   ""
    set command ""
    foreach {junk offset type value junk1 junk2 command} $parse break

    $tree set $node cursor 0 
    parseoffset $tree $node
    parsetype $tree $node
    parsetest $tree $node
    # handle trailing spaces
    if {[string index $value end] eq "\\"} {
   	append value " "
    }
    parsemsg $tree $node

    if {[string index $command end] eq "\\"} {
   	append command " "
    }

    if {$value eq ""} {
    set record [$tree getall $node]
    foreach key $parsedkeys {
	if {![dict exists $record $key]} {
	# badly formatted line
   	return -code error "no value"
    }

	    return -code error [list {missing key} $key]
	}
    }
    ::fileutil::magic::cfront::Debug {
   	puts [list parsed $record]
    }
}
   	puts "level:$level offset:$offset type:$type value:'$value' command:'$command'"

proc ::fileutil::magic::cfront::parsefloat {tree node} {
    set line [$tree get $node line]
    set cursor [$tree get $node cursor]
    # If only [scan] had a @ conversion character like [binary scan]
    set line2 [string range $line $cursor end]
    if {[scan $line2 %e%n num count] < 0} {
	parseerror {invalid floating point number}
    }
    set cursor [expr {$cursor + $count}]
    $tree set $node cursor $cursor

    # These suffixes are not used in magic files
    #if {[regexp -start $cursor {\A([fFlL)} -> modifier]} {
    #    advance [string length $modifier]]
    #}
    return $num
}

proc ::fileutil::magic::cfront::parseint {tree node} {
    set line [$tree get $node line]
    set cursor [$tree get $node cursor]
    # If only [scan] had a @ conversion character like [binary scan]
    set line2 [string range $line $cursor end]
    if {[set scanres [scan $line2 %lli%n num n]] < 1} {
	parseerror {invalid number}
    }
    set cursor [expr {$cursor + $n}]
    $tree set $node cursor $cursor
    # Thse suffixes are not used in magic files
    #if {[regexp -start $cursor {\A([uU]?[lL]{1,2})} -> modifier]} {
    #    advance [string length $modifier]]
    #}
    return $num
}


proc ::fileutil::magic::cfront::parsetype {tree node} {
    variable types_numeric_re
    variable types_numeric_short
    variable types_string_re
    variable types_string_short
    variable types_notimplemented_re
    set line [$tree get $node line]
    set cursor [$tree get $node cursor]
    $tree set $node mod {}
    $tree set $node mand {}
    if {[regexp -start $cursor {\A\s*(\w+)} $line match type]} {
	advance [string length $match]
	switch -regexp -matchvar match $type \
	    ^(u?)($types_numeric_re)$ - ^($types_string_re)$ {

	    set type [lindex $match end]
	    if {[llength $match] == 3} {
		#numeric
		if {[dict exists $types_numeric_short $type]} {
		    set type [dict get $types_numeric_short $type]
		}
		$tree set $node type $type

		# {to do} {Current design doesn't use sign, right?  Is it
		# really not needed?}
		$tree set $node sgn [dict get {{} 1 u 0} [
		    lindex $match 1]]

		parsetypenummod $tree $node
	    } else {
		lassign $match match type
		if {[dict exists $types_string_short $type]} {
		    set type [dict get $types_string_short $type]
		}
		$tree set $node type $type

		# No modifying operator for strings
		parsetypemod $tree $node

		if {$type eq {search} && [$tree get $node mand] eq {}} {
		    parseerror {search has no number}
		}
	    }
	} \
	^(name|use)$ {
	    $tree set $node type [lindex $match end] 
	} \
	$types_notimplemented_re {
	    parseerror {type not implemented}
	} \
	default {
	    parseerror {unknown type}
	}
    } else {
	parseerror {no type}
    }
}

proc ::fileutil::magic::cfront::parsetypemod {tree node} {
    # For numeric types , $mod is a list of modifiers and $mand is either a
    # number or the empty strinng .
    variable typemodifiers
    variable numeric_modifier_allowed
    set type [$tree get $node type]
    if {[advance 1 char] ne {/}} {
	rewind 1
	return
    }
    set res [dict create] 
    while 1 {
	if {[advance 1 char] eq {/}} {
	    continue
	}
	if {[string is space $char]} {
	    break
	}
	if {[dict exists $typemodifiers $type] && $char in [dict get $typemodifiers $type]} {
	    dict set res $char {}
	} elseif {$type in $numeric_modifier_allowed} {
	    rewind 1
	    if {[catch {parseint $tree $node} mand]} {
		# Whatever it is, it isn't a number.  Let the next parsing step
		# handle it .
		break
	    } else {
		$tree set $node mand $mand  ; # numeric modifier
	    }
	} else {
	    parseerror {bad modifier}
	}
    }
    $tree set $node mod [dict keys $res]
}

proc ::fileutil::magic::cfront::parsetypenummod {tree node} {
    # For numeric types, $mod is an operator and $mand is a number
    set line [$tree get $node line]
    set cursor [$tree get $node cursor]
    if {[regexp -start $cursor {\A([-&|^+*/%])} \
	$line match mod]} {
	advance [string length $match]
	$tree set $node mod $mod
	# {to do} {parse floats?}
	$tree set $node mand [parseint $tree $node] ; # mod operand
    } else {
	$tree set $node mod {}
	$tree set $node mand {} 
    }
}


proc ::fileutil::magic::cfront::parsestringval {tree node} {
    variable floattestops
    variable inttestops
    variable stringtestops
    advance w1 char 
    set val {}
    set line [$tree get $node line]
    while 1 {
	# break on whitespace or empty string
	if {[string is space $char] || $char eq {}} break
	switch $char [dict create  \
	    \\ {
		advance 1 char
		if {[string is space $char]} {
		    append val \\$char
		} else {
		    # extra backslashes because of interaction with glob
		    switch -glob $char [dict create \
			{\\} {
			    append val {\\}
			} \t {
			    parsewarning {use \t instead of \<tab>}
			    append val \\t
			} > - < - & - ^ - = - ! - ( - ) - . {
			    if {$char in [list {*}$stringtestops \
				{*}$floattestops {*}$inttestops]} {
				parsewarning {no need to escape operators}
			    }
			    append val $char 
			} a - b - f - n - r - t - v {
			    append val \\$char
			} x {
			    set cursor [$tree get $node cursor]
			    if {[regexp -start $cursor \
				{\A([0-9A-Fa-f]{1,2})} $line match char2]} {
				advance [string length $match] 
				append val \\x$char2
			    } else {
				parseerror {malformed \x escape sequence}
			    }
			} \[0-7\] {
			    set cursor [$tree get $node cursor]
			    append val \\$char
			    if {[regexp -start $cursor \
				{\A([0-7]{1,2})} $line match char2]} {
				advance [string length $match] 
				append val $char2
			    }
			} default {
			    parseerror {Could not handle escape sequence in value}
			}
		    ]
		}
	    } default {
		if {[string is space $char] || $char in [
		    list \# \{ \} \[  \] \" \$ \; \n]} {
		    append val \\
		}
		append val $char
	    }
	]
	advance 1 char
    }
    $tree set $node val $val
}

proc ::fileutil::magic::cfront::parsetestverbatim {tree node} {
    switch [$tree get $node type] {
	name {
	    $tree set $node rel 1
	}
	use {
	    set cursor [$tree get $node cursor]
	    # order matters in regular expression : longest match must come
	    # first in parenthesized
	    if {[regexp -start $cursor {\A\s*(?:\\\^|\^)} [$tree get $node line] match]} {
		advance [string length $match]
		$tree set $node iendian 1
	    } else {
		$tree set $node iendian 0
	    }
	}

    }
    parsestringval $tree $node
}

proc ::fileutil::magic::cfront::parsetest {tree node} {
    variable floattestops
    variable inttestops
    variable stringtestops
    variable types_numeric_real
    variable types_numeric_short
    variable types_string
    variable types_verbatim
    set type [$tree get $node type]
    if {$type in $types_verbatim} {
	parsetestverbatim $tree $node
	return
    }
    $tree set $node compinvert 0
    set testinvert 0
    set comp ==
    advance w1 char
    if {$char eq {x}} {
	advance 1 char
	if {[string is space $char]} {
	    $tree set $node testinvert 0
	    $tree set $node comp x
	    $tree set $node val {}
	    return
	} else {
	    rewind 1
	}
    }

    if {$type in $types_string} {
	while 1  {
	    if {$char in $stringtestops} {
		if {$char eq {!}} {
		    set testinvert 1
		} else {
		    set comp $char
		    # Exclamation must precede any normal operator
		    break
		}
		advance w1 char
	    } else {
		rewind 1
		break
	    }
	}
	parsestringval $tree $node
    } elseif {$type in [list {*}[
	array names ::fileutil::magic::rt::typemap] {*}[
	dict keys $types_numeric_short]]} {
	if {$type in $types_numeric_real} {
	    set ops $floattestops
	    set parsecmd parsefloat
	} else {
	    set ops $inttestops 
	    set parsecmd parseint
	}

	while 1 {
	    if {$char in $ops} {
		if {$char eq {~}} {
		    $tree set $node compinvert 1 
		} elseif {$char eq {!}} {
		    set testinvert 1
		} else {
		    set comp $char
		    # Exclamation and tilde must precede any normal operator
		    break
		}
		advance w1 char
	    } else {
		rewind 1
		break
	    }
	}
	$tree set $node val [$parsecmd $tree $node]
    } else {
	parseerror {don't know how to parse the test or this type}
    }
    switch $comp {
	= {
	    set comp ==
	}
    }
    # This facilitates Switch creation by [treegen1]
    if {$testinvert && ($comp eq {==})} {
	set comp !=
	set testinvert 0
    }
    $tree set $node testinvert $testinvert
    $tree set $node comp $comp 
}

proc ::fileutil::magic::cfront::parseoffset {tree node} {

    # Offset parser.
    # Syntax:
    #   ( ?&? number ?.[bslBSL]? ?[+-]? ?number? )

    # This was all fine and dandy, but didn't do spaces where spaces might
    # exist between lexical elements in the wild, and ididn't do offset
    # operators

    #set n {([-+]?[0-9]+|[-+]?0x[0-9A-Fa-f]+)[UL]*}

    ##"\\((&?)(${n})((\\.\[bslBSL])?)()(\[+-]?)(${n}?)\\)"
    #set o \
    #    "^(&?)${n}((?:\\.\[bslBSL])?)(?:(\[-+*/%&|^])${n})?(?:(\[+-])(\\()?${n}\\)?)?$"
    ##     |   |   |                     |            |        |      |    |
    ##     1   2   3                     4            5        6      7    8 
    ##                            1    2    3     4   5        6    7     8   
    #set ok [regexp $o $offset -> irel base type  iop ioperand sign ind idx]


    variable offsetopts
    variable indir_typemap
    $tree set $node rel 0 ;   # relative
    $tree set $node ind 0 ;   # indirect
    $tree set $node ir 0 ;    # indirect relative
    $tree set $node it {} ;   # indir_type
    $tree set $node ioi 0 ;   # indirect offset invert
    $tree set $node iir 0 ;   # indirect indirect relative 
    $tree set $node ioo 0 ;   # indirect_offset_op
    $tree set $node io 0 ;    # indirect offset
    advance w1 char
    if {$char eq {&}} {
	advance w1 char
	$tree set $node rel 1
    }

    if {$char eq {(}} {
	$tree set $node ind 1

	if {[advance w1] eq {&}} {
	    $tree set $node ir 1
	} else {
	    rewind 1
	}
	$tree set $node o [parseint $tree $node]

	# $char is used below if it's not "."
	if {[advance w1 char] eq {.}} {
	    advance w1 it
	    if {[dict exists $indir_typemap $it]} {
		set it [
		    dict get $indir_typemap $it]
	    } else {
		parseerror {bad indirect offset type}
	    }
	    advance w1 char
	} else {
	    set it long
	}
	$tree set $node it $it


	# The C implementation does this, so we will , too .
	if {$char eq {~}} {
	    advance w1 char
	    $tree set $node ioi 1
	}

	if {$char in $offsetopts} {
	    $tree set $node ioo $char
	    if {[advance w1] in {(}} {
		$tree set $node iir 1
	    } else {
		rewind 1
	    }
	    $tree set $node io [parseint $tree $node]
	    if {[$tree get $node iir]} {
		if {[advance w1] ne {)}} {
		    parseerror {
			expected closing parenthesis for indirect indirect offset offset
		    }
		}
	    }
	    advance w1 char
	}

	if {$char ne {)}} {
	    parseerror {
		expected close parenthesis for indirect offset 
	    }
	}
    } else {
	rewind 1
	$tree set $node o [parseint $tree $node]
    }
}

proc ::fileutil::magic::cfront::parseoffsetmod {tree node} {
    advance w1 char
    if {$char eq {~}} {
	$tree set $node offset_invert 1
	advance w1 char
    } else {
	$tree set $node offset_invert 0
    }
    switch $char {
	+ - - - * - / - % - & - | - ^ {
	    $tree set $node offset_mod_op $char
	    $tree set $node offset_mod [parseint $tree $node]
	}
	default {
	    $tree set $node offset_mod_op {}
	    $tree set $node offset_mod {}
	    rewind 1
	    # no offset modifier
	}
    }
}

proc ::fileutil::magic::cfront::parsemsg {tree node} {
    advance w
    # return the line's fields
    return [list $level $offset $type $value $command]
    set line [$tree get $node line]
    set cursor [$tree get $node cursor]
    ##leave \b in the message for [emit] to parse
    #regexp -start $cursor {\A(\b|\\b)?(.*)$} $line match b line
    #if {$b ne {}} {
    #    $tree set $node space 0
    #} else {
    #    $tree set $node space 1
    #}
    set line [string range $line $cursor end]
    $tree set $node desc $line
}

# process a magic file
proc ::fileutil::magic::cfront::process {file {maxlevel 10000}} {
proc ::fileutil::magic::cfront::process {tree file {maxlevel 10000}} {
    variable hashprotection
    variable hashprotectionB
    variable level	;# level of line
    variable linenum	;# line number

    set level  0

    set linenum 0
    set records {}
    set rejected 0
    set script {}
    if {[$tree keyexists root files]} {
	set files [$tree get root files]
    } else {
	set files {}

    set linenum 0
    }
    set fileidx [llength $files] 
    if {$file in $files} {
	return -code error [list {already processed file} $file]
    }
    lappend files $file
    $tree set root files $files
    $tree set root level -1
    set node root
    ::fileutil::foreachLine line $file {
   	incr linenum
	# Only trim the left side . White space on the the right side could be
	# part of an escape sequence , and trimming would munge it .
   	set line [string trim $line " "]
   	if {[string index $line 0] eq "#"} {
   	set line [string trimleft $line]
   	if {[string index $line 0] eq {#}} {
   	    continue	;# skip comments
   	} elseif {$line == ""} {
   	} elseif {$line eq {}} {
   	    continue	;# skip blank lines
   	} else {
   	    # parse line
	    if {[regexp {!:(\S+)\s*(.*)$} $line -> extname extdata]} {
   	    if {[catch {parseline $line $maxlevel} parsed]} {
   		continue	;# skip erroring lines
   	    }

		if {$rejected} {
		    continue
		}
		if {$node eq {root}} {
   	    # got a valid line
   	    foreach {level offset type value message} $parsed break

		    return -code error [list {malformed magic file}]
   	    # strip comparator out of value field,
   	    # (they are combined)
   	    set compare [string index $value 0]
   	    switch -glob --  $value {
   		[<>]=* {
   		    set compare [string range $value 0 1]
   		    set value   [string range $value 2 end]
   		}

		}
		$tree set $node ext_$extname $extdata
   		<* - >* - &* - ^* {
   		    set value [string range $value 1 end]
   		}

	    } else {
		# calculate the line's level
   		=* {
   		    set compare "=="
   		    set value   [string range $value 1 end]
		set unlevel [string trimleft $line >]
   		}

		set level   [expr {[string length $line] - [string length $unlevel]}]
   		!* {
   		    set compare "!="
		set line $unlevel
   		    set value   [string range $value 1 end]
   		}

   		x {
		if {$level > $maxlevel} {
		    return -code continue "Skip - too high a level"
		}
		if {$level > 0} {
		    if {$rejected} {
   		    # this is the 'don't care' match
   		    # used for collecting values
			continue
   		    set value ""
   		}

		    }
		    while {[$tree keyexists $node level] && [$tree get $node level] >= $level} {
   		default {
   		    # the default comparator is equals
   		    set compare "=="
			set node [$tree parent $node]
   		    if {[string match {\\[<!>=]*} $value]} {
   			set value [string range $value 1 end]
   		    }
		    }
   		}
   	    }

		    if {$level > [$tree get $node level]+1} {
   	    # process type field
   	    set qual ""
			return -code error [
   	    switch -glob -- $type {
   		pstring* - string* {
   		    # String or Pascal string type

			    list {level more than one greater than parent level} \
   		    # extract string match qualifiers
		    foreach {type qual} [split $type /] break

				file $file linenum $linenum line $line]
   		    # convert pstring to string + qualifier
   		    if {$type eq "pstring"} {
   			append qual "p"
   			set type "string"
   		    }

		    }
		    set node [$tree insert $node end]
   		    # protect hashes in output script value
   		    set value [string map $hashprotection $value]

		} else {
   		    if {($value eq "\\0") && ($compare eq ">")} {
   			# record 'any string' match
   			set value   ""
   			set compare x
		    set rejected 0
		    set node [$tree insert root end]
   		    } elseif {$compare eq "!="} {
   			# string doesn't allow !match
   			set value   !$value
   			set compare "=="
   		    }

		    set node0 $node
		}
		$tree set $node file $fileidx
   		    if {$type ne "string"} {
   			# don't let any odd string types sneak in
   			puts stderr "Reject String: ${file}:$linenum $type - $line"
   			continue
   		    }
   		}

		$tree set $node line $line
   		regex {
   		    # I am *not* going to handle regex
   		    puts stderr "Reject Regex: ${file}:$linenum $type - $line"
		$tree set $node linenum $linenum
   		    continue
   		}

		$tree set $node level $level
   		*byte* - *short* - *long* - *date* {
   		    # Numeric types

		if {[catch {parseline $tree $node} cres copts]} {
   		    # extract numeric match &qualifiers
   		    set type [split  $type &]
   		    set qual [lindex $type 1]

   		    if {$qual ne ""} {
		    set errorcode [dict get $copts -errorcode]
		    if {[lindex $errorcode 0] eq {fumagic} && [
			lindex $errorcode 1] eq {parse error}} {
			$tree delete $node0
   			# this is an &-qualifier
   			set qual &$qual
   		    } else {
			set rejected 1
			puts stderr [list Rejected {bad parse}]
			puts stderr [dict get $copts -errorinfo]
			continue	;# skip erroring lines
		    } else {
   			# extract -qualifier from type
   			set type [split  $type -]
   			set qual [lindex $type 1]
   			if {$qual ne ""} {
   			    set qual -$qual
   			}
   		    }
   		    set type [lindex $type 0]

			return -options $copts $cres
   		    # perform value adjustments
   		    if {$compare ne "x"} {
   			# trim redundant Long value qualifier
   			set value [string trimright $value L]

		    }
   			if {[catch {set value [expr $value]} x]} {
			    upvar #0 errorInfo eo
   			    # check that value is representable in tcl
   			    puts stderr "Reject Value Error: ${file}:$linenum '$value' '$line' - $eo"
   			    continue;
   			}


		}
   			# coerce numeric value into hex
   			set value [format "0x%x" $value]
   		    }
	    }
   		}

   		default {
   		    # this is not a type we can handle
   		    puts stderr "Reject Unknown Type: ${file}:$linenum $type - $line"
   		    continue
   		}
   	    }
   	}

   	# collect some summaries
   	::fileutil::magic::cfront::Debug {
   	    variable types
   	    set types($type) $type
   	    set types($type) [$tree get $node type]
   	    variable quals
   	    set quals($qual) $qual
   	    set quals($qual) [$tree get $node qual]
   	}

   	#puts $linenum level:$level offset:$offset type:$type
	#puts qual:$qual compare:$compare value:'$value' message:'$message'
	#puts qual:$qual compare:$compare val:'$val' desc:'$desc'

   	# protect hashes in output script message
   	set message [string map $hashprotectionB $message]

    }
   	if {![string match "(*)" $offset]} {
   	    catch {set offset [expr $offset]}
   	}
}

   	# record is the complete match command,
   	# encoded for tcl code generation
   	set record [list $linenum $type $qual $compare $offset $value $message]
   	if {$script == {}} {
   	    # the original script has level 0,
   	    # regardless of what the script says
   	    set level 0
   	}


   	if {$level == 0} {
   	    # add a new 0-level record
   	    lappend script $record
   	} else {
   	    # find the growing edge of the script
   	    set depth [::struct::list repeat [expr $level] end]
   	    while {[catch {
   		# get the insertion point
   		set insertion [eval [linsert $depth 0 lindex $script]]
		# 8.5 #	set insertion [lindex $script {*}$depth]
   	    }]} {
   		# handle scripts which jump levels,
   		# reduce depth to current-depth+1
   		set depth [lreplace $depth end end]
   	    }

   	    # add the record at the insertion point
   	    lappend insertion $record

   	    # re-insert the record into its correct position
   	    eval [linsert [linsert $depth 0 lset script] end $insertion]
   	    # 8.5 # lset script {*}$depth $insertion
   	}
    }
    #puts "Script: $script"
    return $script
}

# compile up magic files or directories of magic files into a single recognizer.
proc ::fileutil::magic::cfront::compile {args} {
    set tcl ""
    set script {}
    set tree [tree]

    foreach arg $args {
   	if {[file type $arg] == "directory"} {
   	if {[file type $arg] eq  {directory}} {
   	    foreach file [glob [file join $arg *]] {
   		set script1 [process $file]
   		process $tree $file
		eval [linsert $script1 0 lappend script [list file $file]]
   		# 8.5 # lappend script [list file $file] {*}$script1

   		#append tcl "magic::file_start $file" \n
   		#append tcl [run $script1] \n
   	    }
	    #append tcl "magic::file_start $file" \n
	    #append tcl [run $script1] \n
   	    }
   	} else {
   	    set file $arg
   	    set script1 [process $file]
   	    process $tree $file
   	     eval [linsert $script1 0 lappend script [list file $file]]
   	    # 8.5 # lappend script [list file $file] {*}$script1

   	    #append tcl "magic::file_start $file" \n
   	    #append tcl [run $script1] \n
	    #append tcl "magic::file_start $file" \n
	    #append tcl [run $script1] \n
   	}
    }

    #puts stderr $script
    ::fileutil::magic::cfront::Debug {puts "\# $args"}

    # Historically, this command converted the output of [process] , which was
    # a list , into a tree . Now it post-processes the tree .
    set    t   [2tree $script]
    set    tcl [treegen $t root]
    cgen 2tree $tree

    append tcl "\nreturn \{\}"
    set tests [cgen treegen $tree root]
    set named [$tree get root named]

    ::fileutil::magic::cfront::Debug {puts [treedump $t]}
    #set tcl [run $script]

    return $tcl
    return [list $named $tests]
}

proc ::fileutil::magic::cfront::procdef {procname args} {
proc ::fileutil::magic::cfront::generate {namespace args} {

    set pspace [namespace qualifiers $procname]
    set pspace [namespace qualifiers $namespace]

    if {$pspace eq ""} {
	return -code error "Cannot generate recognizer in the global namespace"
    }

    set     script {}
    lappend script "package require fileutil::magic::rt"
    lappend script "namespace eval [list ${pspace}] \{"
    lappend script "    namespace import ::fileutil::magic::rt::*"
    lappend script "\}"
    lassign [compile {*}$args] named tests

    set script "namespace eval [list $namespace] {
	variable named [list $named]
	variable tests [list $tests]
    }"
    lappend script ""
    lappend script [list proc ${procname} {} \n[eval [linsert $args 0 compile]]\n]
    return [join $script \n]
    return $script 
}

proc ::fileutil::magic::cfront::install {args} {
    foreach arg $args {
	set path [file tail $arg]
	eval [procdef ::fileutil::magic::/${path}::run $arg]
	eval [generate ::fileutil::magic::/$path $arg]
    }
    return
}

proc ::fileutil::magic::cfront::tree {} {
    set tree [::struct::tree]

    $tree set root path ""
    $tree set root otype Root
    $tree set root type root
    $tree set root named {}
    $tree set root message "unknown"
    return $tree
}

# ### ### ### ######### ######### #########
## Internal, debugging.

if {!$::fileutil::magic::cfront::debug} {
    # This procedure definition is optimized out of using code by the
    # core bcc. It knows that neither argument checks are required,

# cgen.tcl --
#
#	Generator core for compiler of magic(5) files into recognizers
#	based on the 'rtcore'.
#
# Copyright (c) 2016      Poor Yorick     <[email protected]>
# Copyright (c) 2004-2005 Colin McCormack <[email protected]>
# Copyright (c) 2005      Andreas Kupries <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: cgen.tcl,v 1.7 2007/06/23 03:39:34 andreas_kupries Exp $

# Wiki page last updated: ???
#
#####

# ### ### ### ######### ######### #########
## Requirements

package require Tcl 8.4
package require Tcl 8.6
package require fileutil::magic::rt ; # Runtime core, for Access to the typemap
package require struct::list        ; # Our data structures.
package require struct::tree        ; #

package provide fileutil::magic::cgen 1.0
package provide fileutil::magic::cgen 1.2

# ### ### ### ######### ######### #########
## Implementation

namespace eval ::fileutil::magic {
    namespace export *
}
namespace eval ::fileutil::magic::cgen {
    namespace ensemble create
    namespace export *
    # Import the runtime typemap into our scope.
    variable ::fileutil::magic::rt::typemap

    # The tree most operations use for their work.
    variable tree {}

    # Generator data structure.
    variable regions

    # Type mapping for indirect offsets.
    # Export the API
    # empty -> long/Q, because this uses native byteorder.

    namespace export 2tree treedump treegen
    array set otmap {
        .b c    .B c
        .s s    .S S
        .l i    .L I
	{} Q
    }


   # Assumption : the parser folds the test inversion operator into equality and
   # inequality operators .
    variable offsetskey {
	type o rel ind ir it ioi ioo iir io compinvert mod mand
    }
    # Export the API
    namespace export 2tree treedump treegen
}


# Optimisations:

# reorder tests according to expected or observed frequency this
# conflicts with reduction in strength optimisations.

# - String tests at same level over overlapping ranges can be
#   written as sub-string comparisons over the maximum range
#   this saves re-reading the same string from file.
#
# - common prefix strings will have to be guarded against, by
#   sorting string values, then sorting the tests in reverse length order.


proc ::fileutil::magic::cgen::path {tree} {
    # Annotates the tree. In each node we store the path from the root
    # to this node, as list of nodes, with the current node the last
    # element. The root node is never stored in the path.

    $tree set root path {}
    foreach child [$tree children root] {
   	$tree walk $child -type dfs node {
   	    set path [$tree get [$tree parent $node] path]
   	    lappend path [$tree index $node]
   	    $tree set $node path $path
   	}
    }
    return
}

proc ::fileutil::magic::cgen::tree_el {tree parent file line type qual comp offset val message args} {
proc ::fileutil::magic::cgen::tree_el {tree node} {
    set parent [$tree parent $node]
    if {[$tree keyexists $parent path]} {
	set path [$tree get $parent path]
    } else {
	set path {} 
    }
    lappend path [$tree index $node]
    $tree set $node path $path

    foreach name {type} {
	set $name [$tree get $node $name]
    }

    # Recursively creates and annotates a node for the specified
    # tests, and its sub-tests (args).

    set     node [$tree insert $parent end]
    set     path [$tree get    $parent path]
    lappend path [$tree index  $node]
    $tree set $node path $path

    # generate a proc call type for the type, Numeric or String
    variable ::fileutil::magic::rt::typemap

    switch -glob -- $type {
   	*byte* -
	*double* -
   	*short* -
   	*long* -
	*quad* -
   	*date* {
   	    set otype N
   	    set type [lindex $typemap($type) 1]
   	    $tree set $node otype N
   	}
   	clear - default - search - regex - *string* {
   	    $tree set $node otype S
   	}
   	*string {
   	    set otype S
   	}
	name {
	    $tree set $node otype A
	}
	use {
	    $tree set $node otype U
	}
   	default {
   	    puts stderr "Unknown type: '$type'"
	    $tree set $node otype Unknown
   	}
    }

    # Stores the type determined above, and the arguments into
    # attributes of the new node.

    foreach key {line type qual comp offset val message file otype} {
   	if {[catch {
   	    $tree set $node $key [set $key]
   	} result]} {
	    upvar ::errorInfo eo
   	    puts "Tree: $eo - $file $line $type"
   	}
    }

    # now add children
    foreach el $args {
    foreach el [$tree children $node] {
	eval [linsert $el 0 tree_el $tree $node $file]
   	# 8.5 # tree_el $tree $node $file {*}$el
	tree_el $tree $el
    }
    return $node
    return
}

proc ::fileutil::magic::cgen::2tree {script} {
proc ::fileutil::magic::cgen::2tree {tree} {

    # Converts a recognizer which is in a simple script form into a
    # tree.

    foreach child [$tree children root] {
    variable tree
    set tree [::struct::tree]

    $tree set root path ""
    $tree set root otype Root
    $tree set root type root
    $tree set root message "unknown"

    # generate a test for each match
    set file "unknown"
    foreach el $script {
   	#puts "EL: $el"
   	if {[lindex $el 0] eq "file"} {
   	    set file [lindex $el 1]
   	} else {
	    set node [eval [linsert $el 0 tree_el $tree root $file]]
	    # 8.5 # set more [tree_el $tree root $file {*}$el]
	tree_el $tree $child
   	    append result $node
   	}
    }
    optNum $tree root
    #optStr $tree root
    puts stderr "Script contains [llength [$tree children root]] discriminators"
    path $tree

    # Decoding the offsets, determination if we have to handle

    foreach el $strings {
   	#if {[$tree get $el otype] eq "String"} {puts "[$tree getall $el] - [string length [$tree get $el val]]"}
	if {[$tree get $el comp] eq "x"} {
	    continue
	}

	set offset [$tree get $el offset]
	set o [$tree get $el o]
	set len    [string length [$tree get $el val]]
	lappend regions([list $offset $len]) $el
	lappend regions([list $o $len]) $el
    }
}

proc ::fileutil::magic::cgen::isNum {tree node} {
    return [expr {"N" eq [$tree get $node otype]}]
}

proc ::fileutil::magic::cgen::switchNSort {tree n1 n2} {
    return [expr {[$tree get $n1 val] - [$tree get $n1 val]}]
}

proc ::fileutil::magic::cgen::optNum {tree node} {
    variable offsetskey
    array set offsets {}

    # traverse each numeric element of this node's children,
    # categorising them

    set kids [$tree children $node]
    foreach child $kids {
	optNum $tree $child
    }

    set numerics [$tree children $node filter ::fileutil::magic::cgen::isNum]
    #puts stderr "optNum: $node: $numerics"
    if {[llength $numerics] < 2} {
	return
    }

    foreach el $numerics {
	if {[$tree get $el comp] ne "=="} {
	if {[$tree get $el comp] ne {==}} {
	    continue
	}
	set key {}
	foreach name $offsetskey {
	    lappend key [$tree get $el $name]
	}
	lappend offsets([$tree get $el type],[$tree get $el offset],[$tree get $el qual]) $el
	lappend offsets([join $key ,]) $el
    }

    #puts "Offset: stderr [array get offsets]"
    foreach {match nodes} [array get offsets] {
	if {[llength $nodes] < 2} {
	    continue
	}

		puts stderr "* clashes with <[$tree getall $matcher($nv)]>"
		puts stderr "*====================================="
	    } else {
		set matcher($nv) $n
	    }
	}

	foreach {type offset qual} [split $match ,] break
	foreach $offsetskey [split $match ,] break
	set switch [$tree insert $node [$tree index [lindex $nodes 0]]]
	$tree set $switch otype   Switch
	$tree set $switch message $match
	$tree set $switch offset  $offset
	$tree set $switch type    $type
	$tree set $switch desc $match
	foreach name $offsetskey {
	    $tree set $switch $name [set $name]
	$tree set $switch qual    $qual
	}

	set nodes [lsort -command [list ::fileutil::magic::cgen::switchNSort $tree] $nodes]

	eval [linsert $nodes 0 $tree move $switch end]
	# 8.5 # $tree move $switch end {*}$nodes
	set     path [$tree get [$tree parent $switch] path]
	lappend path [$tree index $switch]
	$tree set $switch path $path

	set level [$tree get [$tree parent $switch] level]
	$tree set $switch level [expr {$level+1}]
    }
}

proc ::fileutil::magic::cgen::Offsets {tree} {

    # Indicator if a node has to save field location information for
    # relative addressing. The 'kill' attribute is an accumulated
    # 'save' over the whole subtree. It will be used to determine when
    # level information was destroyed by subnodes and has to be
    # regenerated at the current level.

    $tree walk root -type dfs node {
	$tree set $node kill 0
	if {[$tree get $node otype] ne {Root} &&
	    ([$tree get $node rel] || [$tree get $node ir])} {
	$tree set $node save 0
	$tree set $node kill 0
	    $tree set $node save 1
	} else {
	    $tree set $node save 0
	}
    }

    # We walk from the leafs up to the root, synthesizing the data
    # needed, as we go.
    $tree walk root -type dfs -order post node {
	if {$node eq "root"} continue
	if {$node eq {root}} continue
	DecodeOffset $tree $node [$tree get $node offset]

	# If the current node's parent is a switch, and the node has
	# to save, then the switch has to save. Because the current
	# node is not relevant during code generation anymore, the
	# switch is.

	if {[$tree get $node save]} {
	    # We save, therefore we kill.
	    $tree set $node kill 1
	    if {[$tree get [$tree parent $node] otype] eq "Switch"} {
	    if {[$tree get [$tree parent $node] otype] eq {Switch}} {
		$tree set [$tree parent $node] save 1
	    }
	} else {
	    # We don't save i.e. kill, but we may inherit it from
	    # children which kill.

	    foreach c [$tree children $node] {
		if {[$tree get $c kill]} {
		    $tree set $node kill 1
		    break
		}
	    }
	}
    }
}

proc ::fileutil::magic::cgen::DecodeOffset {tree node offset} {
    if {[string match "(*)" $offset]} {
	# Indirection offset. (Decoding is non-trivial, therefore
	# packed into a proc).

	set ind 1 ; # Indirect location
	foreach {rel base itype idelta} [DecodeIndirectOffset $offset] break

# Useful when debugging
    } elseif {[string match "&*" $offset]} {
	# Direct relative offset. (Decoding is trivial)

	set ind    0       ; # Direct location
	set rel    1       ; # Relative
	set base   [string range $offset 1 end] ; # Base Delta
	set itype  {}      ; # No data for indirect
	set idelta {}      ; # s.a.

    } else {
	set ind    0       ; # Direct location
	set rel    0       ; # Absolute
	set base   $offset ; # Here!
	set itype  {}      ; # No data for indirect
	set idelta {}      ; # s.a.
    }

    # Store the expanded data back into the tree.

    foreach v {ind rel base itype idelta} {
	$tree set $node $v [set $v]
    }

    # For nodes with adressing relative to last field above the latter
    # has to save this information.

    if {$rel} {
	$tree set [$tree parent $node] save 1
    }
    return
}

proc ::fileutil::magic::cgen::DecodeIndirectOffset {offset} {
    variable otmap ; # Offset typemap.

    # Offset parser.
proc ::fileutil::magic::cgen::stack {tree node} {
    set res {}
    set files [$tree get root files]
    while 1 {
	set s [dict create \
    # Syntax:
    #   ( ?&? number ?.[bslBSL]? ?[+-]? ?number? )

	    file [lindex $files [$tree get $node file]] \
    set n {(([0-9]+)|(0x[0-9A-Fa-f]+))}
    set o "\\((&?)(${n})((\\.\[bslBSL])?)(\[+-]?)(${n}?)\\)"
    #         |   | ||| ||               |       | |||
    #         1   2 345 67               8       9 012
    #         ^   ^     ^                ^       ^
    #         rel base  type             sign    index
    #
    #                            1   2    3 4 5 6    7 8    9   0 1 2
    set ok [regexp $o $offset -> rel base _ _ _ type _ sign idx _ _ _]

    if {!$ok} {
        return -code error "Bad offset \"$offset\""
	    linenum [$tree get $node linenum]]
	if {[$tree keyexists $node origin]} {
	    set origin [$tree get $node origin]
	    dict set s origin [dict create \
    }

		name [$tree get $origin val] \
    # rel is in {"", &}, map to 0|1
    if {$rel eq ""} {set rel 0} else {set rel 1}

		file [lindex $files [$tree get $origin file]] \
    # base is a number, enforce decimal. Not optional.
    set base [expr $base]

		linenum [$tree get $origin linenum]]
	}
    # Type is in .b .s .l .B .S .L, and "". Map to a regular magic
    # type code.
    set type $otmap($type)

	set res [linsert $res 0 $s]
	set node [$tree parent $node]
    # sign is in {+,-,""}. Map to -|"" (Becomes sign of index)
    if {$sign eq "+"} {set sign ""}

	if {$node eq {root}} {
	    break
    # Index is optional number. Enforce decimal, empty is zero. Add in
    # the sign as well for a proper signed index.

	}
    if {$idx eq ""} {set idx 0}
    set idx $sign[expr $idx]

    return [list $rel $base $type $idx]
    }
    return $res
}

proc ::fileutil::magic::cgen::treedump {tree} {
    set result ""
    $tree walk root -type dfs node {
	set path  [$tree get $node path]
	set depth [llength $path]

	append result [string repeat "  " $depth] [list $path] ": " [$tree get $node type]:

	if {[$tree keyexists $node offset]} {
	    append result " ,O|[$tree get $node offset]|"
	if {[$tree keyexists $node o]} {
	    append result " ,O|[$tree get $node o]|"

	    set x {}
	    foreach v {ind rel base itype idelta} {lappend x [$tree get $node $v]}
	    foreach v {ind rel base itype iop ioperand idelta} {lappend x [$tree get $node $v]}
	    append result "=<[join $x !]>"
	}
	if {[$tree keyexists $node qual]} {
	    set q [$tree get $node qual]
	    if {$q ne ""} {
		append result " ,q/$q/"
	    }

	}

	if {[$tree keyexists $node otype]} {
	    append result " " [$tree get $node otype]/[$tree get $node save]
	}

	if {$depth == 1} {
	    set msg [$tree get $node message]
	    set msg [$tree get $node desc]
	    set n $node
	    while {($n != {}) && ($msg == "")} {
		set n [lindex [$tree children $n] 0]
		if {$n != {}} {
		    set msg [$tree get $n message]
		    set msg [$tree get $n desc]
		}
	    }
	    append result " " ( $msg )
	    if {[$tree keyexists $node file]} {
		append result " - " [$tree get $node file]
	    }
	}

	#append result " <" [$tree getall $node] >
	append result \n
    }
    return $result
}

proc ::fileutil::magic::cgen::treegen {tree node} {
    return "[treegen1 $tree $node]\nresult\n"
}

proc ::fileutil::magic::cgen::treegen1 {tree node} {
    variable ::fileutil::magic::rt::typemap

    set result ""
    set result {} 
    foreach k {otype type offset comp val qual message save path} {
	if {[$tree keyexists $node $k]} {
	    set $k [$tree get $node $k]
	}
    }
    set named [$tree get root named]
    set otype [$tree get $node otype]
    set level [$tree get $node level]

    set indent \n[string repeat \t [expr {$level > 0 ? $level-1 : 0}]]

    # Generate code for each node per its type.

    set level [llength $path]

    # Generate code for each node per its type.

    switch $otype {
    switch $otype {
	A {
	    set file [$tree get $node file]
	    set val [$tree get $node val]
	    if {[dict exists named $file$val]} {
		return -code error [list {name already exists} $file $val]
	    }
	    set aresult {}
	    foreach child [$tree children $node] {
		lappend aresult [treegen $tree $child]
	    }
	    dict set named $file $val [join $aresult \n]
	    $tree set root named $named
	    return
	}
	U {
	    set file [$tree get $node file]
	    set val [$tree get $node val]
	    append result "U [list $file] [list $val]\n" 
	}
	N -
	S {
	    set names {type mod mand testinvert compinvert comp val desc kill save path}
	    foreach name $names {
		set $name [$tree get $node $name]
	    }

	    set o [GenerateOffset $tree $node]

	    if {$val eq {}} {
		# If the value is the empty string, armor it.  Otherwise, it's
		# already been armored.
		set val [list $val]
	    }

	    if {$otype eq {N}} {
	    if {$save} {
		# We have to save field data for relative adressing under this
		# leaf.
		if {$kill} {
		    # We have to save field data for relative adressing under this
		    # leaf.
		if {$otype eq "N"} {
		    set type [list Nx $level $type]
		    set type [list Nx $type]
		} elseif {$otype eq "S"} {
		    set type [list Sx $level]
		}
	    } else {
		# Regular fetching of information.
		} else {
		    # Regular fetching of information.
		if {$otype eq "N"} {
		    set type [list N $type]
		}
		# $type and $o are expanded via substitution 
		append result "${indent}if \{\[$type $o [list $testinvert] [
		    list $compinvert] [list $mod] [list $mand] [
		    list $comp] $val\]\} \{>\n"
		} elseif {$otype eq "S"} {
		    set type S
	    } elseif {$otype eq {S}} {
		switch $comp {
		    == {set comp eq}
		}
	    }

		    != {set comp ne}
	    set offset [GenerateOffset $tree $node]

	    if {$qual eq ""} {
		append result "if \{\[$type $offset $comp [list $val]\]\} \{"
	    } else {
		append result "if \{\[$type $offset $comp [list $val] $qual\]\} \{"
		}
		if {$kill} {
		    set type [list Sx $type]
		} else {
		    set type [list S $type]
		}
		append result "${indent}if \{\[$type $o [list $testinvert] [
		    list $mod] [list $mand] [list $comp] $val\]\} \{>\n"
	    }

	    if {[$tree isleaf $node]} {
	    if {[$tree isleaf $node] && $desc ne {}} {
		if {$message ne ""} {
		    append result "emit [list $message]"
		} else {
		append result "${indent}emit [list $desc]"
	    } else {
		    append result "emit [$tree get $node path]"
		}
	    } else {
		# If we saved data the child branches may destroy
		# level information. We regenerate it if needed.

		if {$desc ne {}} {
		if {$message ne ""} {
		    append result "emit [list $message]\n"
		    append result "${indent}emit [list $desc]\n"
		}

		set killed 0
		foreach child [$tree children $node] {
		    if {$save && $killed && [$tree get $child rel]} {
			# This location already does not regenerate if
			# the killing subnode was last. We also do not
			# need to regenerate if the current subnode
			# does not use relative adressing.
			append result "L $level;"
			set killed 0
		    }
		    append result [treegen1 $tree $child]
		    append result [treegen $tree $child]
		    set killed [expr {$killed || [$tree get $child kill]}]
		}
		#append result "\nreturn \$result"
	    }

	    if {[$tree keyexists $node ext_mime]} {
		append result "${indent}mime [$tree get $node ext_mime]\n"
	    }

	    if {[$tree keyexists $node ext_ext]} {
		append result "${indent}ext [$tree get $node ext_ext]\n"
	    }

	    append result "\}\n"
	    append result "\n<\}\n"
	}
	Root {
	    foreach child [$tree children $node] {
		append result [treegen1 $tree $child]
		lappend result [treegen $tree $child]
		if {[lindex $result end] eq {}} {
		    set result [lreplace $result[set result {}] end end]
		}
	    }
	}
	Switch {
	    set names {o type compinvert mod mand kill save}
	    foreach name $names {
		set $name [$tree get $node $name]
	    }
	    set offset [GenerateOffset $tree $node]
	    set o [GenerateOffset $tree $node]

	    if {$save} {
		set fetch "Nvx $level"
	    if {$kill} {
		set fetch Nvx
	    } else {
		set fetch Nv
	    }

	    append fetch " " $type " " $offset
	    if {$qual ne ""} {
		append fetch " " $qual
	    append fetch " $type $o [list $compinvert] [list $mod] [list $mand]"
	    }
	    append result "switch -- \[$fetch\] "
	    append result "${indent}switch -- \[$fetch\] "

	    set scan [lindex $typemap($type) 1]

	    set ckilled 0
	    foreach child [$tree children $node] {
		# See ::fileutil::magic::rt::rtscan
		binary scan [binary format $scan [$tree get $child val]] $scan val
		append result "$val \{"

		if {$save && $ckilled} {
		if {$scan eq {me}} {
		    set scan I
		}

		    # This location already does not regenerate if
		    # the killing subnode was last. We also do not
		    # need to regenerate if the current subnode
		    # does not use relative adressing.
		    append result "L $level;"
		# get value in binary form, then back to numeric
		# this avoids problems with sign, as both values are
		# [binary scan]-converted identically
		binary scan [binary format $scan [$tree get $child val]] $scan val

		append result "$val \{>;"
		    set ckilled 0
		}

		if {[$tree isleaf $child]} {
		    append result "emit [list [$tree get $child message]]"

		set desc [$tree get $child desc]
		if {[$tree isleaf $child] && $desc ne {}} {
		    append result "emit [list [$tree get $child desc]]"
		} else {
		    set killed 0
		    append result "emit [list [$tree get $child message]]\n"
		    if {$desc ne {}} {
			append result "emit [list [$tree get $child desc]]\n"
		    }
		    foreach grandchild [$tree children $child] {
			if {$save && $killed && [$tree get $grandchild rel]} {
			    # This location already does not regenerate if
			    # the killing subnode was last. We also do not
			    # need to regenerate if the current subnode
			    # does not use relative adressing.
			    append result "L $level;"
			append result [treegen $tree $grandchild]
			    set killed 0
			}
			append result [treegen1 $tree $grandchild]
			set killed [expr {$killed || [$tree get $grandchild kill]}]
		    }
		}

		set ckilled [expr {$ckilled || [$tree get $child kill]}]
		append result "\} "
		    }
		}
		if {[$tree keyexists $child ext_mime]} {
		    append result "${indent}mime [$tree get $child ext_mime]\n"
		}

		if {[$tree keyexists $child ext_ext]} {
		    append result "${indent}ext [$tree get $child ext_ext]\n"
		}

		append result ";<\} "
	    }
	    append result "\n"
	    append result "\n<\n"
	}
    }
    return $result
}

proc ::fileutil::magic::cgen::GenerateOffset {tree node} {
    # Examples:
    # direct absolute:     45      -> 45
    # direct relative:    &45      -> [R 45]
    # indirect absolute:  (45.s+1) -> [I 45 s 1]
    # indirect relative: (&45.s+1) -> [I [R 45] s 1]
    # indirect absolute:  (45.s+1) -> [I 45 s + 0 1]
    # indirect absolute (indirect offset):  (45.s+(1)) -> [I 45 s + 1 1]
    # relative indirect absolute:  &(45.s+1) -> [R [I 45 s + 0 1]]
    # relative indirect absolute (indirect offset):  &(45.s+(1)) -> [R [I 45 s + 1 1]]
    # indirect relative: (&45.s+1) -> [I [R 45] s op 0 1]
    # relative indirect relative: &(&45.s+1) -> [R [I [R 45] s + 0 1]]
    # relative indirect relative: &(&45.s+(1)) -> [R [I [R 45] s + 1 1]]

    foreach v {ind rel base itype idelta} {
    foreach v {o rel ind ir it ioi iir ioo io} {
	set $v [$tree get $node $v]
    }

    #foreach v {ind rel base itype iop ioperand iindir idelta} {
    #    set $v [$tree get $node $v]
    #}

    if {$ind} {
	if {$ir} {set o "\[R $o]"}
	set o "\[I $o [list $it] [list $ioi] [list $ioo] [list $iir] [list $io]\]"
    }
    if {$rel} {set base "\[R $base\]"}
    if {$ind} {set base "\[I $base $itype $idelta\]"}
    return $base
    if {$rel} {
	set o "\[R $o\]"
    }
    
    return $o
}

# ### ### ### ######### ######### #########
## Ready for use.
# EOF

The core part of the recognizer was generated from a "magic(5)" file
containing the checks to perform to recognize files, and associated
file-types.

[para]

[emph Beware!] This recognizer is large, about 276 Kilobyte of
[emph Beware!] This recognizer is large, about 752 Kilobyte of
generated Tcl code.

[list_begin definitions]

[call [cmd ::fileutil::magic::filetype] [arg filename]]

This command is similar to the command [cmd fileutil::fileType].

[para]

The output of the command for the specified file is a string
describing the type of the file.
Returns a list containing a list of descriptions, a list of mimetype
components, and a list file extensions.  Returns an empty string if the file
content is not recognized.

[para]

This list will be empty if the type of the file is not recognized.

[list_end]

# Copyright (c) 2005-2006 by Andreas Kupries <[email protected]>
# All rights reserved.
#
# RCS: @(#) $Id: filetypes.test,v 1.9 2006/10/09 21:41:40 andreas_kupries Exp $

# -------------------------------------------------------------------------

package require tcltest
source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.4
testsNeedTcltest 1.0

test fumagic.filetype-1.2 {test file directory} {
    set f [makeDirectory fileTypeTest]
    set res [catch {fileutil::magic::filetype $f} msg]
    regsub {file[0-9]+} $msg {fileXXX} msg
    removeDirectory fileTypeTest
    list $res $msg
} {0 directory}
} {0 {directory application/x-directory {}}}

test fumagic.filetype-1.3 {test file empty} {
    set f [makeEmptyFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeEmptyFile
    list $res $msg
} {0 {}}

test fumagic.filetype-1.4 {test simple binary} {
    set f [makeBinFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeBinFile
    list $res $msg
} {0 {}}

test fumagic.filetype-1.5 {test elf executable} {
    set f [makeElfFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeElfFile
    list $res $msg
} {0 {ELF 32-bit LSB AT&T WE32100 - invalid byte order, relocatable, \(\) \(SYSV\)}}
} {0 {{ELF 32-bit LSB executable, {*unknown arch 0x0*} (SYSV)} {application x-executable} {}}}

test fumagic.filetype-1.6 {test simple text} {
    set f [makeTextFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeTextFile
    list $res $msg
} {0 {}}

test fumagic.filetype-1.7 {test script file} {
    set f [makeScriptFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeScriptFile
    list $res $msg
} {0 {a /bin/tclsh script text executable}}
} {0 {{a {/bin/tclsh script text executable}} {} {}}}

test fumagic.filetype-1.8 {test html text} {
    set f [makeHtmlFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeHtmlFile
    list $res $msg
} {0 {HTML document text}}
} {0 {{{HTML document text}} {text html} {}}}

# 1.9/.10 possibly broken output.
test fumagic.filetype-1.9 {test xml text} {
    set f [makeXmlFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeXmlFile
    list $res $msg
} {0 {XML document text \"	XML XML %.3s document text broken XML document text}}
} {0 {{XML {1.0 document text}} {text xml} {}}}

test fumagic.filetype-1.10 {test xml with dtd text} {
    set f [makeXmlDTDFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeXmlDTDFile
    list $res $msg
} {0 {{XML {1.0 document text}} {text xml} {}}}
} {0 {XML document text \"	XML XML %.3s document text broken XML document text}}


test fumagic.filetype-1.11 {test PGP message} {
test fumagic.filetype-1.11 {
	test PGP message. Their are multiple matches, and the longest match should
	carry greater weight, and thus be the one returnes.  If the match is "PGP
	armored data message", this isn't happening.
} {
    set f [makePGPFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removePGPFile
    list $res $msg
} {0 {PGP armored data message}}
} {0 {{{PGP message}} {application pgp} {}}}

test fumagic.filetype-1.12 {test binary graphic jpeg} {
test fumagic.filetype-1.12.0 {test binary graphic jpeg} {
    set f [makeJpegFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeJpegFile
    list $res $msg
} {0 {{{JPEG image data, JFIF standard 1.02, resolution (DPI), density 300x316, segment length 16}} {image jpeg} {jpeg jpg jpe jfif}}}
} {0 {JPEG image data , JFIF standard  1. %02d , thumbnail 2x 2}}

#the result should actually be 128x112, but current magic files indicate "byte" instead of "ubyte"
test fumagic.filetype-1.12.1 {test binary graphic jpeg} {
    set f [makeJpeg2File]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeJpeg2File
    list $res $msg
} {0 {{{JPEG image data, JFIF standard 1.02, resolution (DPI), density 300x316, segment length 16, thumbnail -128x112}} {image jpeg} {jpeg jpg jpe jfif}}}

test fumagic.filetype-1.13 {test binary graphic gif} {
    set f [makeGifFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeGifFile
    list $res $msg
} {0 {GIF image data , version 89a,}}
} {0 {{{GIF image data, version 89a,} {43 x} 64} {image gif} {}}}

test fumagic.filetype-1.14 {test binary graphic png} {
    set f [makePngFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removePngFile
    list $res $msg
} {0 {{{PNG image data, 0 x} 0, 0-bit} {image png} {}}}

#{To do} {implement a "wild guess" mode}
#test fumagic.filetype-1.14.1 {test binary graphic png} {
#    set f [makePngFile]
#    set res [catch {fileutil::magic::filetype $f} msg]
#    removePngFile
#    list $res $msg
} {0 {PNG image data, CORRUPTED, PNG image data, CORRUPTED}}
#} {0 {PNG image data, CORRUPTED, PNG image data, CORRUPTED}}

# The file doesn't really provide a direntries value, so not sure what the
# result means here, but any number is good enough for this test.
test fumagic.filetype-1.15 {test binary graphic tiff} {
    set f [makeTiffFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeTiffFile
    list $res $msg
} {0 {TIFF image data, big-endian}}
} {0 {{{TIFF image data, big-endian, direntries=19789}} {image tiff} {}}}

test fumagic.filetype-1.16 {test binary pdf} {
    set f [makePdfFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removePdfFile
    list $res $msg
} {0 {PDF document , version 1 .2}}
} {0 {{{PDF document, version 1.2}} {application pdf} {}}}

test fumagic.filetype-1.17 {test text ps} {
    set f [makePSFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removePSFile
    list $res $msg
} {0 {PostScript document text}}
} {0 {{{PostScript document text}} {application postscript} {}}}

test fumagic.filetype-1.18 {test text eps} {
    set f [makeEPSFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeEPSFile
    list $res $msg
} {0 {PostScript document text}}
} {0 {{{PostScript document text}} {application postscript} {}}}

test fumagic.filetype-1.19 {test binary gravity_wave_data_frame} {
    set f [makeIgwdFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeIgwdFile
    list $res $msg
} {0 {}}

test fumagic.filetype-1.20 {test binary compressed bzip} {
    set f [makeBzipFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeBzipFile
    list $res $msg
} {0 {bzip2 compressed data bzip compressed data , version: h , compression block size 900k}}
} {0 {{{bzip2 compressed data, block size = 900k}} {application x-bzip2} {}}}

test fumagic.filetype-1.21 {test binary compressed gzip} {
    set f [makeGzipFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeGzipFile
    list $res $msg
} {0 {{{gzip compressed data, reserved method, ASCII, last modified: 1}} {application x-gzip} {}}}
} {0 {gzip compressed data , unknown method , ASCII , from MS-DOS}}

test fumagic.filetype-1.22 {test pstring} {
    set f [makewsdlFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removewsdlFile
    list $res $msg
} {0 {{{PHP WSDL cache,} {version 0x03, created 7, uri: "hello", source: "some source", target_ns: "and a target"}} {} {}}}
 
test fumagic.filetype-1.23 {regular expressions} {
    set f [makeCSourceFile]
    set res [catch {fileutil::magic::filetype $f} msg]
    removeCSourceFile
    list $res $msg
} {0 {{{C source text}} {text x-c} {}}}

testsuiteCleanup
return

    {checkSimpleArgs 1 -1 {
	checkFileName
    }}
pcx::check 1.0 std ::fileutil::magic::cfront::install \
    {checkSimpleArgs 1 -1 {
	checkFileName
    }}
pcx::check 1.0 std ::fileutil::magic::cfront::procdef \
pcx::check 1.0 std ::fileutil::magic::cfront::generate \
    {checkSimpleArgs 2 -1 {
	checkWord
	checkFileName
    }}

# Initialization via pcx::init.
# Use a ::fileutil::magic::cfront::init procedure for non-standard initialization.

abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
}

# ### ### ### ######### ######### #########
## Creates a series of commands for the creation of small data files
## for various file formats.

foreach {name data} [list \
foreach {name data} [dict create \
	Empty  {} \
	Bin    "\u0000" \
	Elf    [cat "\x7F" "ELF" "\x01\x01\x01\x00\x00"] \
	Elf    [cat "\x7F" "ELF" "\x01\x01\x01\x00\x00" "\x00\x00\x00\x00\x00\x00\x00" "\x02\x00"] \
	Bzip   "BZh91AY&SY\x01\x01\x01\x00\x00" \
	Gzip   "\x1f\x8b\x01\x01\x01\x00\x00" \
	Jpeg   [cat "\xFF\xD8\xFF\xE0\x00\x10JFIF" "\x00\x01\x02\x01\x01\x2c"] \
	Jpeg   [cat "\xFF\xD8\xFF\xE0\x00\x10JFIF" "\x00\x01\x02\x01\x01\x2c\x01\x3c"] \
	Jpeg2   [cat "\xFF\xD8\xFF\xE0\x00\x10JFIF" "\x00\x01\x02\x01\x01\x2c\x01\x3c\x80\x70"] \
	Gif    "GIF89a\x2b\x00\x40\x00\xf7\xff\x00" \
	Png    "\x89PNG\x0D\x0A\x1A\x0A" \
	Png    "\x89PNG\x00\x01\x02\x01\x01\x2c" \
	PngMalformed "\x89PNG\x00\x01\x02\x01\x01\x2c" \
	Tiff   "MM\x00\*\x00\x01\x02\x01\x01\x2c" \
	Pdf    "%PDF-1.2 \x00\x01\x02\x01\x01\x2c" \
	Igwd   "IGWD\x00\x01\x02\x01\x01\x2c"
	Igwd   "IGWD\x00\x01\x02\x01\x01\x2c" \
	wsdl "wsdl\x03 \x07\x00\x00\x00\x05\x00\x00\x00hello\x0b\x00\x00\x00some source\x0c\x00\x00\x00and a targetxxxmore text" 
	] {
    proc make${name}File   {} [list makeBinaryFile $data $name]
    proc remove${name}File {} [list removeFile           $name]
}

foreach {name data} [list \
foreach {name data} [dict create \
	CSource "#include <stdio.h>\nint main(int argc, char *argv[]) {int a;}" \
	PS     "%!PS-ADOBO-123 EPSF-1.4" \
	EPS    "%!PS-ADOBO-123 EPSF-1.4" \
	Text   "simple text" \
	Script "#!/bin/tclsh" \
	Html   "<html></html>" \
	Xml    $xmlData \
	XmlDTD $xmlDataWithDTD \

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin fileutil::magic::mimetype n 1.0.2]
[see_also file(1)]
[see_also fileutil]
[see_also magic(5)]
[keywords {file recognition}]
[keywords {file type}]
[keywords {file utilities}]
[keywords mime]
[keywords type]
[moddesc   {file utilities}]
[titledesc {Procedures implementing mime-type recognition}]
[category  {Programming tools}]
[require Tcl 8.4]
[require fileutil::magic::mimetype [opt 1.0.2]]
[description]
[para]

This package provides a command for the recognition of file types in
pure Tcl. The output is standardized to mime-types.

[para]

The core part of the recognizer was generated from a "magic(5)" file
containing the checks to perform to recognize files, and associated
mime-types.

[list_begin definitions]

[call [cmd ::fileutil::magic::mimetype] [arg filename]]

This command is similar to the command [cmd fileutil::fileType].

[para]

The output of the command for the specified file is not a list of
attributes describing the type of the file, but a list of standard
mime-types the file may have.

[para]

This list will be empty if the type of the file is not recognized.

[list_end]

[section REFERENCES]

[list_begin enumerated]
[enum]
[uri ftp://ftp.astron.com/pub/file/ {File(1) sources}]

This site contains the current sources for the file command, including
the magic definitions used by it. The latter were used by us to
generate this recognizer.

[list_end]

[vset CATEGORY {fileutil :: magic}]
[include ../doctools2base/include/feedback.inc]
[manpage_end]

# mimetypes.tcl --
#
#	Tcl based file type recognizer using the runtime core and
#	generated from /usr/share/misc/magic.mime. Limited output,
#	but only mime-types, i.e. standardized.
#
# Copyright (c) 2004-2005 Colin McCormack <[email protected]>
# Copyright (c) 2005-2006 Andreas Kupries <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: mimetypes.tcl,v 1.8 2006/09/27 21:19:35 andreas_kupries Exp $

#####
#
# "mime type discriminator"
# http://wiki.tcl.tk/12537
#
# Tcl code harvested on:  10 Feb 2005, 04:16 GMT
# Wiki page last updated: ???
#
#####

# ### ### ### ######### ######### #########
## Requirements.

package require Tcl 8.4
package require fileutil::magic::rt    ; # We need the runtime core.

# ### ### ### ######### ######### #########
## Implementation

namespace eval ::fileutil::magic {}

proc ::fileutil::magic::mimetype {file} {
    if {![file exists $file]} {
        return -code error "file not found: \"$file\""
    }
    if {[file isdirectory $file]} {
	return application/x-directory
    }

    rt::open $file
    mimetype::run
    rt::close
    set types [rt::resultv]

    if {[llength $types]} {
	# We postprocess the data if needed, as the low-level
	# recognizer can return duplicate information.

	array set _ {}
	set utypes  {}
	foreach t $types {
	    if {[info exists _($t)]} continue
	    lappend utypes $t
	    set _($t) .
	    set types $utypes
	}
    }
    return $types
}

package provide fileutil::magic::mimetype 1.0.2
# The actual recognizer is the command below.

##
## -- Do not edit after this line !
## -- ** BEGIN GENERATED CODE ** --

package require fileutil::magic::rt
namespace eval ::fileutil::magic::mimetype {
    namespace import ::fileutil::magic::rt::*
}

proc ::fileutil::magic::mimetype::run {} {
    switch -- [Nv s 0 ] 1538 {emit application/x-alan-adventure-game} 387 {emit application/x-executable-file} -147 {emit application/data} -155 {emit application/data} -5536 {emit application/x-arj} -138 {emit application/data} -394 {emit application/data} -650 {emit application/x-lzh} 387 {emit application/x-executable-file} 392 {emit application/x-executable-file} 399 {emit application/x-object-file} -13230 {emit {RLE image data,}} 322 {emit {basic-16 executable}} 323 {emit {basic-16 executable \(TV\)}} 328 {emit application/x-executable-file} 329 {emit application/x-executable-file} 330 {emit application/x-executable-file} 338 {emit application/x-executable-file} 332 {emit application/x-executable-file} 1078 {emit font/linux-psf} 387 {emit {ECOFF alpha}} 332 {emit {MS Windows COFF Intel 80386 object file}} 358 {emit {MS Windows COFF MIPS R4000 object file}} 388 {emit {MS Windows COFF Alpha object file}} 616 {emit {MS Windows COFF Motorola 68000 object file}} 496 {emit {MS Windows COFF PowerPC object file}} 656 {emit {MS Windows COFF PA-RISC object file}} 263 {emit {PDP-11 executable}} 257 {emit {PDP-11 UNIX/RT ldp}} 261 {emit {PDP-11 old overlay}} 264 {emit {PDP-11 pure executable}} 265 {emit {PDP-11 separate I&D executable}} 287 {emit {PDP-11 kernel overlay}} 4843 {emit {SYMMETRY i386 .o}} 8939 {emit {SYMMETRY i386 executable \(0 @ 0\)}} 13035 {emit {SYMMETRY i386 executable \(invalid @ 0\)}} 17131 {emit {SYMMETRY i386 standalone executable}} 376 {emit {VAX COFF executable}} 381 {emit {VAX COFF pure executable}} -155 {emit x.out} 518 {emit {Microsoft a.out}} 320 {emit {old Microsoft 8086 x.out}} 1408 {emit {XENIX 8086 relocatable or 80286 small model}}
    if {[S 0 == TADS ]} {emit application/x-tads-game}
    switch -- [Nv S 0 ] 272 {emit application/x-executable-file} 273 {emit application/x-executable-file} 29127 {emit application/x-cpio} -14479 {emit application/x-bcpio} -147 {emit application/data} -155 {emit application/data} 368 {emit application/x-executable-file} 369 {emit application/x-executable-file} 1793 {emit application/x-executable-file} 262 {emit application/x-executable-file} 1537 {emit application/x-executable-file} 381 {emit application/x-executable-file} 383 {emit application/x-executable-file} 7967 {emit application/data} 8191 {emit application/data} -13563 {emit application/data} 1281 {emit application/x-locale} 340 {emit application/data} 341 {emit application/x-executable-file} 286 {emit font/x-vfont} 7681 {emit font/x-vfont} 407 {emit application/x-executable-file} 404 {emit application/x-executable-file} 200 {emit {hp200 \(68010\) BSD}} 300 {emit {hp300 \(68020+68881\) BSD}} 351 {emit {370 XA sysV executable}} 346 {emit {370 XA sysV pure executable}} 22529 {emit {370 sysV pure executable}} 23041 {emit {370 XA sysV pure executable}} 23809 {emit {370 sysV executable}} 24321 {emit {370 XA sysV executable}} 345 {emit {SVR2 executable \(Amdahl-UTS\)}} 348 {emit {SVR2 pure executable \(Amdahl-UTS\)}} 344 {emit {SVR2 pure executable \(USS/370\)}} 349 {emit {SVR2 executable \(USS/370\)}} 479 {emit {executable \(RISC System/6000 V3.1\) or obj module}} 260 {emit {shared library}} 261 {emit {ctab data}} -508 {emit {structured file}} 12320 {emit {character Computer Graphics Metafile}} -40 {emit image/jpeg} 474 {emit x/x-image-sgi} 4112 {emit {PEX Binary Archive}} -21267 {emit {Java serialization data}} -32768 {emit {lif file}} 256 {emit {raw G3 data, byte-padded}} 5120 {emit {raw G3 data}} 336 {emit {mc68k COFF}} 337 {emit {mc68k executable \(shared\)}} 338 {emit {mc68k executable \(shared demand paged\)}} 364 {emit {68K BCS executable}} 365 {emit {88K BCS executable}} 392 {emit {Tower/XP rel 2 object}} 397 {emit {Tower/XP rel 2 object}} 400 {emit {Tower/XP rel 3 object}} 405 {emit {Tower/XP rel 3 object}} 408 {emit {Tower32/600/400 68020 object}} 416 {emit {Tower32/800 68020}} 421 {emit {Tower32/800 68010}} -30771 {emit {OS9/6809 module:}} 19196 {emit {OS9/68K module:}} 373 {emit {i386 COFF object}} 10775 {emit {\"compact bitmap\" format \(Poskanzer\)}} -26368 {emit {PGP key public ring}} -27391 {emit {PGP key security ring}} -27392 {emit {PGP key security ring}} -23040 {emit {PGP encrypted data}} 601 {emit {mumps avl global}} 602 {emit {mumps blt global}} -4693 {emit {}} 10012 {emit {Sendmail frozen configuration}} -30875 {emit {disk quotas file}} 1286 {emit {IRIS Showcase file}} 550 {emit {IRIS Showcase template}} 352 {emit {MIPSEB COFF executable}} 354 {emit {MIPSEL COFF executable}} 24577 {emit {MIPSEB-LE COFF executable}} 25089 {emit {MIPSEL-LE COFF executable}} 355 {emit {MIPSEB MIPS-II COFF executable}} 358 {emit {MIPSEL MIPS-II COFF executable}} 25345 {emit {MIPSEB-LE MIPS-II COFF executable}} 26113 {emit {MIPSEL-LE MIPS-II COFF executable}} 320 {emit {MIPSEB MIPS-III COFF executable}} 322 {emit {MIPSEL MIPS-III COFF executable}} 16385 {emit {MIPSEB-LE MIPS-III COFF executable}} 16897 {emit {MIPSEL-LE MIPS-III COFF executable}} 384 {emit {MIPSEB Ucode}} 386 {emit {MIPSEL Ucode}} -16162 {emit {Compiled PSI \(v1\) data}} -16166 {emit {Compiled PSI \(v2\) data}} -21846 {emit {SoftQuad DESC or font file binary}} 283 {emit {Curses screen image}} 284 {emit {Curses screen image}} 263 {emit {unknown machine executable}} 264 {emit {unknown pure executable}} 265 {emit {PDP-11 separate I&D}} 267 {emit {unknown pure executable}} 392 {emit {Perkin-Elmer executable}} 378 {emit {amd 29k coff noprebar executable}} 890 {emit {amd 29k coff prebar executable}} -8185 {emit {amd 29k coff archive}} 21845 {emit {VISX image file}}
    if {[S 0 == {Core\001} ]} {emit application/x-executable-file}
    if {[S 0 == {AMANDA:\ TAPESTART\ DATE} ]} {emit application/x-amanda-header}
    switch -- [Nv I 0 ] 1011 {emit application/x-executable-file} 999 {emit application/x-library-file} 435 {emit video/mpeg} 442 {emit video/mpeg} 33132 {emit application/x-apl-workspace} 333312 {emit application/data} 333319 {emit application/data} 65389 {emit application/x-ar} 65381 {emit application/data} 33132 {emit application/x-apl-workspace} 1711210496 {emit application/x-ar} 1013019198 {emit application/x-ar} 557605234 {emit application/x-ar} 1314148939 {emit audio/x-multitrack} 779248125 {emit audio/x-pn-realaudio} 262 {emit application/x-executable-file} 327 {emit application/x-object-file} 331 {emit application/x-executable-file} 333 {emit application/x-executable-file} 335 {emit application/x-executable-file} 70231 {emit application/core} 385 {emit application/x-object-file} 391 {emit application/data} 324508366 {emit application/x-gdbm} 398689 {emit application/x-db} 340322 {emit application/x-db} 1234567 {emit image/x11} 4 {emit font/x-snf} 335698201 {emit font/x-libgrx} -12169394 {emit font/x-dos} 168757262 {emit application/data} 252317192 {emit application/data} 135137807 {emit application/data} 235409162 {emit application/data} 34603270 {emit application/x-object-file} 34603271 {emit application/x-executable-file} 34603272 {emit application/x-executable-file} 34603275 {emit application/x-executable-file} 34603278 {emit application/x-library-file} 34603277 {emit application/x-library-file} 34865414 {emit application/x-object-file} 34865415 {emit application/x-executable-file} 34865416 {emit application/x-executable-file} 34865419 {emit application/x-executable-file} 34865422 {emit application/x-library-file} 34865421 {emit application/x-object-file} 34275590 {emit application/x-object-file} 34275591 {emit application/x-executable-file} 34275592 {emit application/x-executable-file} 34275595 {emit application/x-executable-file} 34275598 {emit application/x-library-file} 34275597 {emit application/x-library-file} 557605234 {emit application/x-ar} 34078982 {emit application/x-executable-file} 34078983 {emit application/x-executable-file} 34078984 {emit application/x-executable-file} 34341128 {emit application/x-executable-file} 34341127 {emit application/x-executable-file} 34341131 {emit application/x-executable-file} 34341126 {emit application/x-executable-file} 34210056 {emit application/x-executable-file} 34210055 {emit application/x-executable-file} 34341134 {emit application/x-library-file} 34341133 {emit application/x-library-file} 65381 {emit application/x-library-file} 34275173 {emit application/x-library-file} 34406245 {emit application/x-library-file} 34144101 {emit application/x-library-file} 22552998 {emit application/core} 1302851304 {emit font/x-hp-windows} 34341132 {emit application/x-lisp} 505 {emit {AIX compiled message catalog}} 1123028772 {emit {Artisan image data}} 1504078485 {emit x/x-image-sun-raster} -889275714 {emit {compiled Java class data,}} -1195374706 {emit {Linux kernel}} 1886817234 {emit {CLISP memory image data}} -762612112 {emit {CLISP memory image data, other endian}} -569244523 {emit {GNU-format message catalog data}} -1794895138 {emit {GNU-format message catalog data}} -889275714 {emit {mach-o fat file}} -17958194 {emit mach-o} 31415 {emit {Mirage Assembler m.out executable}} 834535424 {emit text/vnd.ms-word} 6656 {emit {Lotus 1-2-3}} 512 {emit {Lotus 1-2-3}} 263 {emit {NetBSD big-endian object file}} 326773060 {emit font/x-sunos-news} 326773063 {emit font/x-sunos-news} 326773072 {emit font/x-sunos-news} 326773073 {emit font/x-sunos-news} 61374 {emit {OSF/Rose object}} -976170042 {emit {DOS EPS Binary File}} 1351614727 {emit {Pyramid 90x family executable}} 1351614728 {emit {Pyramid 90x family pure executable}} 1351614731 {emit {Pyramid 90x family demand paged pure executable}} 263 {emit {old SGI 68020 executable}} 264 {emit {old SGI 68020 pure executable}} 1396917837 {emit {IRIS Showcase file}} 1413695053 {emit {IRIS Showcase template}} -559039810 {emit {IRIX Parallel Arena}} -559043152 {emit {IRIX core dump}} -559043264 {emit {IRIX 64-bit core dump}} -1161903941 {emit {IRIX N32 core dump}} -1582119980 {emit {tcpdump capture file \(big-endian\)}} 263 {emit {old sun-2 executable}} 264 {emit {old sun-2 pure executable}} 267 {emit {old sun-2 demand paged executable}} 525398 {emit {SunOS core file}} -97271666 {emit {SunPC 4.0 Hard Disk}} 268 {emit {unknown demand paged pure executable}} 269 {emit {unknown demand paged pure executable}} 270 {emit {unknown readable demand paged pure executable}} 50331648 {emit {VMS Alpha executable}} 59399 {emit {object file \(z8000 a.out\)}} 59400 {emit {pure object file \(z8000 a.out\)}} 59401 {emit {separate object file \(z8000 a.out\)}} 59397 {emit {overlay object file \(z8000 a.out\)}}
    if {[N S 0 == 0xfff0 &0xfff0]} {emit audio/mpeg}
    switch -- [Nv s 4 ] -20719 {emit video/fli} -20718 {emit video/flc}
    if {[S 8 == {AVI\	} ]} {emit video/x-msvideo}
    if {[S 0 == MOVI ]} {emit video/x-sgi-movie}
    if {[S 4 == moov ]} {emit video/quicktime}
    if {[S 4 == mdat ]} {emit video/quicktime}
    if {[S 0 == FiLeStArTfIlEsTaRt ]} {emit text/x-apple-binscii}
    if {[S 0 == {\x0aGL} ]} {emit application/data}
    if {[S 0 == {\x76\xff} ]} {emit application/data}
    if {[S 0 == NuFile ]} {emit application/data}
    if {[S 0 == {N\xf5F\xe9l\xe5} ]} {emit application/data}
    if {[S 257 == {ustar\0} ]} {emit application/x-tar}
    if {[S 257 == {ustar\040\040\0} ]} {emit application/x-gtar}
    if {[S 0 == 070707 ]} {emit application/x-cpio}
    if {[S 0 == 070701 ]} {emit application/x-cpio}
    if {[S 0 == 070702 ]} {emit application/x-cpio}
    if {[S 0 == {!<arch>\ndebian} ]} {emit application/x-dpkg}
    if {[S 0 == <ar> ]} {emit application/x-ar}
    if {[S 0 == {!<arch>\n__________E} ]} {emit application/x-ar}
    if {[S 0 == -h- ]} {emit application/data}
    if {[S 0 == !<arch> ]} {emit application/x-ar}
    if {[S 0 == <ar> ]} {emit application/x-ar}
    if {[S 0 == <ar> ]} {emit application/x-ar}
    switch -- [Nv i 0 ] 65389 {emit application/data} 65381 {emit application/data} 236525 {emit application/data} 236526 {emit application/data} 6583086 {emit audio/basic} 204 {emit application/x-executable-file} 324508366 {emit application/x-gdbm} 453186358 {emit application/x-bootable} 4 {emit font/x-snf} 1279543401 {emit application/data} 6553863 {emit {Linux/i386 impure executable \(OMAGIC\)}} 6553864 {emit {Linux/i386 pure executable \(NMAGIC\)}} 6553867 {emit {Linux/i386 demand-paged executable \(ZMAGIC\)}} 6553804 {emit {Linux/i386 demand-paged executable \(QMAGIC\)}} 263 {emit {NetBSD little-endian object file}} 459141 {emit {ECOFF NetBSD/alpha binary}} 33645 {emit {PDP-11 single precision APL workspace}} 33644 {emit {PDP-11 double precision APL workspace}} 234 {emit {BALANCE NS32000 .o}} 4330 {emit {BALANCE NS32000 executable \(0 @ 0\)}} 8426 {emit {BALANCE NS32000 executable \(invalid @ 0\)}} 12522 {emit {BALANCE NS32000 standalone executable}} -1582119980 {emit {tcpdump capture file \(little-endian\)}} 33647 {emit {VAX single precision APL workspace}} 33646 {emit {VAX double precision APL workspace}} 263 {emit {VAX executable}} 264 {emit {VAX pure executable}} 267 {emit {VAX demand paged pure executable}} 518 {emit b.out}
    switch -- [Nv i 0 &0x8080ffff] 2074 {emit application/x-arc} 2330 {emit application/x-arc} 538 {emit application/x-arc} 794 {emit application/x-arc} 1050 {emit application/x-arc} 1562 {emit application/x-arc}
    if {[S 0 == {\032archive} ]} {emit application/data}
    if {[S 0 == HPAK ]} {emit application/data}
    if {[S 0 == {\351,\001JAM\	} ]} {emit application/data}
    if {[S 2 == -lh0- ]} {emit application/x-lha}
    if {[S 2 == -lh1- ]} {emit application/x-lha}
    if {[S 2 == -lz4- ]} {emit application/x-lha}
    if {[S 2 == -lz5- ]} {emit application/x-lha}
    if {[S 2 == -lzs- ]} {emit application/x-lha}
    if {[S 2 == {-lh\40-} ]} {emit application/x-lha}
    if {[S 2 == -lhd- ]} {emit application/x-lha}
    if {[S 2 == -lh2- ]} {emit application/x-lha}
    if {[S 2 == -lh3- ]} {emit application/x-lha}
    if {[S 2 == -lh4- ]} {emit application/x-lha}
    if {[S 2 == -lh5- ]} {emit application/x-lha}
    if {[S 0 == Rar! ]} {emit application/x-rar}
    if {[S 0 == SQSH ]} {emit application/data}
    if {[S 0 == {UC2\x1a} ]} {emit application/data}
    if {[S 0 == {PK\003\004} ]} {emit application/zip}
    if {[N i 20 == 0xfdc4a7dc ]} {emit application/x-zoo}
    if {[S 10 == {\#\ This\ is\ a\ shell\ archive} ]} {emit application/x-shar}
    if {[S 0 == *STA ]} {emit application/data}
    if {[S 0 == 2278 ]} {emit application/data}
    if {[S 0 == {\000\004\036\212\200} ]} {emit application/core}
    if {[S 0 == .snd ]} {emit audio/basic}
    if {[S 0 == MThd ]} {emit audio/midi}
    if {[S 0 == CTMF ]} {emit audio/x-cmf}
    if {[S 0 == SBI ]} {emit audio/x-sbi}
    if {[S 0 == {Creative\ Voice\ File} ]} {emit audio/x-voc}
    if {[S 0 == RIFF ]} {emit audio/x-wav}
    if {[S 8 == AIFC ]} {emit audio/x-aifc}
    if {[S 8 == AIFF ]} {emit audio/x-aiff}
    if {[S 0 == {.ra\375} ]} {emit audio/x-real-audio}
    if {[S 8 == WAVE ]} {emit audio/x-wav}
    if {[S 8 == {WAV\	} ]} {emit audio/x-wav}
    if {[S 0 == RIFF ]} {emit audio/x-riff}
    if {[S 0 == EMOD ]} {emit audio/x-emod}
    if {[S 0 == MTM ]} {emit audio/x-multitrack}
    if {[S 0 == if ]} {emit audio/x-669-mod}
    if {[S 0 == FAR ]} {emit audio/mod}
    if {[S 0 == MAS_U ]} {emit audio/x-multimate-mod}
    if {[S 44 == SCRM ]} {emit audio/x-st3-mod}
    if {[S 0 == {GF1PATCH110\0ID\#000002\0} ]} {emit audio/x-gus-patch}
    if {[S 0 == {GF1PATCH100\0ID\#000002\0} ]} {emit audio/x-gus-patch}
    if {[S 0 == JN ]} {emit audio/x-669-mod}
    if {[S 0 == UN05 ]} {emit audio/x-mikmod-uni}
    if {[S 0 == {Extended\ Module:} ]} {emit audio/x-ft2-mod}
    if {[S 21 == !SCREAM! ]} {emit audio/x-st2-mod}
    if {[S 1080 == M.K. ]} {emit audio/x-protracker-mod}
    if {[S 1080 == M!K! ]} {emit audio/x-protracker-mod}
    if {[S 1080 == FLT4 ]} {emit audio/x-startracker-mod}
    if {[S 1080 == 4CHN ]} {emit audio/x-fasttracker-mod}
    if {[S 1080 == 6CHN ]} {emit audio/x-fasttracker-mod}
    if {[S 1080 == 8CHN ]} {emit audio/x-fasttracker-mod}
    if {[S 1080 == CD81 ]} {emit audio/x-oktalyzer-mod}
    if {[S 1080 == OKTA ]} {emit audio/x-oktalyzer-mod}
    if {[S 1080 == 16CN ]} {emit audio/x-taketracker-mod}
    if {[S 1080 == 32CN ]} {emit audio/x-taketracker-mod}
    if {[S 0 == TOC ]} {emit audio/x-toc}
    if {[S 0 == // ]} {emit text/cpp}
    if {[S 0 == {\\1cw\ } ]} {emit application/data}
    if {[S 0 == {\\1cw} ]} {emit application/data}
    switch -- [Nv I 0 &0xffffff00] -2063526912 {emit application/data} -2063480064 {emit application/data}
    if {[S 4 == pipe ]} {emit application/data}
    if {[S 4 == prof ]} {emit application/data}
    if {[S 0 == {:\ shell} ]} {emit application/data}
    if {[S 0 == {\#!/bin/sh} ]} {emit application/x-sh}
    if {[S 0 == {\#!\ /bin/sh} ]} {emit application/x-sh}
    if {[S 0 == {\#!\	/bin/sh} ]} {emit application/x-sh}
    if {[S 0 == {\#!/bin/csh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\ /bin/csh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\	/bin/csh} ]} {emit application/x-csh}
    if {[S 0 == {\#!/bin/ksh} ]} {emit application/x-ksh}
    if {[S 0 == {\#!\ /bin/ksh} ]} {emit application/x-ksh}
    if {[S 0 == {\#!\	/bin/ksh} ]} {emit application/x-ksh}
    if {[S 0 == {\#!/bin/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\ /bin/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\	/bin/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!/usr/local/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\ /usr/local/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!/usr/local/bin/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\ /usr/local/bin/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!\	/usr/local/bin/tcsh} ]} {emit application/x-csh}
    if {[S 0 == {\#!/usr/local/bin/zsh} ]} {emit application/x-zsh}
    if {[S 0 == {\#!\ /usr/local/bin/zsh} ]} {emit application/x-zsh}
    if {[S 0 == {\#!\	/usr/local/bin/zsh} ]} {emit application/x-zsh}
    if {[S 0 == {\#!/usr/local/bin/ash} ]} {emit application/x-sh}
    if {[S 0 == {\#!\ /usr/local/bin/ash} ]} {emit application/x-zsh}
    if {[S 0 == {\#!\	/usr/local/bin/ash} ]} {emit application/x-zsh}
    if {[S 0 == {\#!/usr/local/bin/ae} ]} {emit text/script}
    if {[S 0 == {\#!\ /usr/local/bin/ae} ]} {emit text/script}
    if {[S 0 == {\#!\	/usr/local/bin/ae} ]} {emit text/script}
    if {[S 0 == {\#!/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/usr/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /usr/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/usr/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/usr/local/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /usr/local/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/usr/local/bin/nawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/usr/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /usr/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/usr/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/usr/local/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /usr/local/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/usr/local/bin/gawk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/bin/awk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /bin/awk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/bin/awk} ]} {emit application/x-awk}
    if {[S 0 == {\#!/usr/bin/awk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\ /usr/bin/awk} ]} {emit application/x-awk}
    if {[S 0 == {\#!\	/usr/bin/awk} ]} {emit application/x-awk}
    if {[S 0 == BEGIN ]} {emit application/x-awk}
    if {[S 0 == {\#!/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!\ /bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!\	/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {eval\ \"exec\ /bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!/usr/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!\ /usr/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!\	/usr/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {eval\ \"exec\ /usr/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!/usr/local/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!\ /usr/local/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!\	/usr/local/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {eval\ \"exec\ /usr/local/bin/perl} ]} {emit application/x-perl}
    if {[S 0 == {\#!/bin/rc} ]} {emit text/script}
    if {[S 0 == {\#!\ /bin/rc} ]} {emit text/script}
    if {[S 0 == {\#!\	/bin/rc} ]} {emit text/script}
    if {[S 0 == {\#!/bin/bash} ]} {emit application/x-sh}
    if {[S 0 == {\#!\ /bin/bash} ]} {emit application/x-sh}
    if {[S 0 == {\#!\	/bin/bash} ]} {emit application/x-sh}
    if {[S 0 == {\#!/usr/local/bin/bash} ]} {emit application/x-sh}
    if {[S 0 == {\#!\ /usr/local/bin/bash} ]} {emit application/x-sh}
    if {[S 0 == {\#!\	/usr/local/bin/bash} ]} {emit application/x-sh}
    if {[S 0 == {\#!\ /} ]} {emit text/script}
    if {[S 0 == {\#!\	/} ]} {emit text/script}
    if {[S 0 == {\#!/} ]} {emit text/script}
    if {[S 0 == {\#!\ } ]} {emit text/script}
    if {[S 0 == {\037\235} ]} {emit application/compress}
    if {[S 0 == {\037\213} ]} {emit application/x-gzip}
    if {[S 0 == {\037\036} ]} {emit application/data}
    if {[S 0 == {\377\037} ]} {emit application/data}
    if {[S 0 == BZh ]} {emit application/x-bzip2}
    if {[S 0 == {\037\237} ]} {emit application/data}
    if {[S 0 == {\037\236} ]} {emit application/data}
    if {[S 0 == {\037\240} ]} {emit application/data}
    if {[S 0 == BZ ]} {emit application/x-bzip}
    if {[S 0 == {\x89\x4c\x5a\x4f\x00\x0d\x0a\x1a\x0a} ]} {emit application/data}
    switch -- [Nv I 24 ] 60011 {emit application/data} 60012 {emit application/data} 60013 {emit application/data} 60014 {emit application/data} 60012 {emit application/x-dump} 60011 {emit application/x-dump}
    if {[S 0 == GDBM ]} {emit application/x-gdbm}
    if {[S 0 == {<list>\n<protocol\ bbn-m} ]} {emit application/data}
    if {[S 0 == {diff\ } ]} {emit text/x-patch}
    if {[S 0 == {***\ } ]} {emit text/x-patch}
    if {[S 0 == {Only\ in\ } ]} {emit text/x-patch}
    if {[S 0 == {Common\ subdirectories:\ } ]} {emit text/x-patch}
    if {[S 0 == {!<arch>\n________64E} ]} {emit application/data}
    if {[S 0 == {\377\377\177} ]} {emit application/data}
    if {[S 0 == {\377\377\174} ]} {emit application/data}
    if {[S 0 == {\377\377\176} ]} {emit application/data}
    if {[S 0 == {\033c\033} ]} {emit application/data}
    if {[S 0 == {!<PDF>!\n} ]} {emit application/x-prof}
    switch -- [Nv i 24 ] 60012 {emit application/x-dump} 60011 {emit application/x-dump}
    if {[S 0 == {\177ELF} ]} {emit application/x-executable-file}
    if {[N s 1080 == 0xef53 ]} {emit application/x-linux-ext2fs}
    if {[S 0 == {\366\366\366\366} ]} {emit application/x-pc-floppy}
    if {[N S 508 == 0xdabe ]} {emit application/data}
    if {[N s 510 == 0xaa55 ]} {emit application/data}
    switch -- [Nv s 1040 ] 4991 {emit application/x-filesystem} 5007 {emit application/x-filesystem} 9320 {emit application/x-filesystem} 9336 {emit application/x-filesystem}
    if {[S 0 == {-rom1fs-\0} ]} {emit application/x-filesystem}
    if {[S 395 == OS/2 ]} {emit application/x-bootable}
    if {[S 0 == FONT ]} {emit font/x-vfont}
    if {[S 0 == %!PS-AdobeFont-1.0 ]} {emit font/type1}
    if {[S 6 == %!PS-AdobeFont-1.0 ]} {emit font/type1}
    if {[S 0 == {STARTFONT\040} ]} {emit font/x-bdf}
    if {[S 0 == {\001fcp} ]} {emit font/x-pcf}
    if {[S 0 == {D1.0\015} ]} {emit font/x-speedo}
    if {[S 0 == flf ]} {emit font/x-figlet}
    if {[S 0 == flc ]} {emit application/x-font}
    switch -- [Nv I 7 ] 4540225 {emit font/x-dos} 5654852 {emit font/x-dos}
    if {[S 4098 == DOSFONT ]} {emit font/x-dos}
    if {[S 0 == <MakerFile ]} {emit application/x-framemaker}
    if {[S 0 == <MIFFile ]} {emit application/x-framemaker}
    if {[S 0 == <MakerDictionary ]} {emit application/x-framemaker}
    if {[S 0 == <MakerScreenFont ]} {emit font/x-framemaker}
    if {[S 0 == <MML ]} {emit application/x-framemaker}
    if {[S 0 == <BookFile ]} {emit application/x-framemaker}
    if {[S 0 == <Maker ]} {emit application/x-framemaker}
    switch -- [Nv i 0 &0377777777] 8782087 {emit application/x-executable-file} 8782088 {emit application/x-executable-file} 8782091 {emit application/x-executable-file} 8782028 {emit application/x-executable-file}
    if {[S 7 == {\357\020\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0} ]} {emit application/core}
    if {[S 0 == {GIMP\ Gradient} ]} {emit application/x-gimp-gradient}
    if {[S 0 == {gimp\ xcf} ]} {emit application/x-gimp-image}
    if {[S 20 == GPAT ]} {emit application/x-gimp-pattern}
    if {[S 20 == GIMP ]} {emit application/x-gimp-brush}
    if {[S 0 == {\336\22\4\225} ]} {emit application/x-locale}
    if {[S 0 == {\225\4\22\336} ]} {emit application/x-locale}
    if {[S 0 == {\000\001\000\000\000} ]} {emit font/ttf}
    if {[S 0 == Bitmapfile ]} {emit image/unknown}
    if {[S 0 == IMGfile ]} {emit {CIS 	image/unknown}}
    if {[S 0 == msgcat01 ]} {emit application/x-locale}
    if {[S 0 == HPHP48- ]} {emit {HP48 binary}}
    if {[S 0 == %%HP: ]} {emit {HP48 text}}
    if {[S 0 == 0xabcdef ]} {emit {AIX message catalog}}
    if {[S 0 == <aiaff> ]} {emit archive}
    if {[S 0 == FORM ]} {emit {IFF data}}
    if {[S 0 == P1 ]} {emit image/x-portable-bitmap}
    if {[S 0 == P2 ]} {emit image/x-portable-graymap}
    if {[S 0 == P3 ]} {emit image/x-portable-pixmap}
    if {[S 0 == P4 ]} {emit image/x-portable-bitmap}
    if {[S 0 == P5 ]} {emit image/x-portable-graymap}
    if {[S 0 == P6 ]} {emit image/x-portable-pixmap}
    if {[S 0 == IIN1 ]} {emit image/tiff}
    if {[S 0 == {MM\x00\x2a} ]} {emit image/tiff}
    if {[S 0 == {II\x2a\x00} ]} {emit image/tiff}
    if {[S 0 == {\x89PNG} ]} {emit image/x-png}
    if {[S 1 == PNG ]} {emit image/x-png}
    if {[S 0 == GIF8 ]} {emit image/gif}
    if {[S 0 == {\361\0\100\273} ]} {emit image/x-cmu-raster}
    if {[S 0 == id=ImageMagick ]} {emit {MIFF image data}}
    if {[S 0 == {\#FIG} ]} {emit {FIG image text}}
    if {[S 0 == ARF_BEGARF ]} {emit {PHIGS clear text archive}}
    if {[S 0 == {@(\#)SunPHIGS} ]} {emit SunPHIGS}
    if {[S 0 == GKSM ]} {emit {GKS Metafile}}
    if {[S 0 == BEGMF ]} {emit {clear text Computer Graphics Metafile}}
    if {[N S 0 == 0x20 &0xffe0]} {emit {binary Computer Graphics Metafile}}
    if {[S 0 == yz ]} {emit {MGR bitmap, modern format, 8-bit aligned}}
    if {[S 0 == zz ]} {emit {MGR bitmap, old format, 1-bit deep, 16-bit aligned}}
    if {[S 0 == xz ]} {emit {MGR bitmap, old format, 1-bit deep, 32-bit aligned}}
    if {[S 0 == yx ]} {emit {MGR bitmap, modern format, squeezed}}
    if {[S 0 == {%bitmap\0} ]} {emit {FBM image data}}
    if {[S 1 == {PC\ Research,\ Inc} ]} {emit {group 3 fax data}}
    if {[S 0 == hsi1 ]} {emit image/x-jpeg-proprietary}
    if {[S 0 == BM ]} {emit image/x-bmp}
    if {[S 0 == IC ]} {emit image/x-ico}
    if {[S 0 == PI ]} {emit {PC pointer image data}}
    if {[S 0 == CI ]} {emit {PC color icon data}}
    if {[S 0 == CP ]} {emit {PC color pointer image data}}
    if {[S 0 == {/*\ XPM\ */} ]} {emit {X pixmap image text}}
    if {[S 0 == {Imagefile\ version-} ]} {emit {iff image data}}
    if {[S 0 == IT01 ]} {emit {FIT image data}}
    if {[S 0 == IT02 ]} {emit {FIT image data}}
    if {[S 2048 == PCD_IPI ]} {emit x/x-photo-cd-pack-file}
    if {[S 0 == PCD_OPA ]} {emit x/x-photo-cd-overfiew-file}
    if {[S 0 == {SIMPLE\ \ =} ]} {emit {FITS image data}}
    if {[S 0 == {This\ is\ a\ BitMap\ file} ]} {emit {Lisp Machine bit-array-file}}
    if {[S 0 == !! ]} {emit {Bennet Yee's \"face\" format}}
    if {[S 1536 == {Visio\ (TM)\ Drawing} ]} {emit %s}
    if {[S 0 == {\210OPS} ]} {emit {Interleaf saved data}}
    if {[S 0 == <!OPS ]} {emit {Interleaf document text}}
    if {[S 4 == pgscriptver ]} {emit {IslandWrite document}}
    if {[S 13 == DrawFile ]} {emit {IslandDraw document}}
    if {[N s 0 == 0x9600 &0xFFFC]} {emit {little endian ispell}}
    if {[N S 0 == 0x9600 &0xFFFC]} {emit {big endian ispell}}
    if {[S 0 == KarmaRHD ]} {emit {Version	Karma Data Structure Version}}
    if {[S 0 == lect ]} {emit {DEC SRC Virtual Paper Lectern file}}
    if {[S 53 == yyprevious ]} {emit {C program text \(from lex\)}}
    if {[S 21 == {generated\ by\ flex} ]} {emit {C program text \(from flex\)}}
    if {[S 0 == {%\{} ]} {emit {lex description text}}
    if {[S 0 == {\007\001\000} ]} {emit {Linux/i386 object file}}
    if {[S 0 == {\01\03\020\04} ]} {emit {Linux-8086 impure executable}}
    if {[S 0 == {\01\03\040\04} ]} {emit {Linux-8086 executable}}
    if {[S 0 == {\243\206\001\0} ]} {emit {Linux-8086 object file}}
    if {[S 0 == {\01\03\020\20} ]} {emit {Minix-386 impure executable}}
    if {[S 0 == {\01\03\040\20} ]} {emit {Minix-386 executable}}
    if {[S 0 == *nazgul* ]} {emit {Linux compiled message catalog}}
    if {[N i 216 == 0x111 ]} {emit {Linux/i386 core file}}
    if {[S 2 == LILO ]} {emit {Linux/i386 LILO boot/chain loader}}
    if {[S 0 == 0.9 ]} {emit 300}
    if {[S 4086 == SWAP-SPACE ]} {emit {Linux/i386 swap file}}
    if {[S 514 == HdrS ]} {emit {Linux kernel}}
    if {[S 0 == Begin3 ]} {emit {Linux Software Map entry text}}
    if {[S 0 == {;;} ]} {emit {Lisp/Scheme program text}}
    if {[S 0 == {\012(} ]} {emit {byte-compiled Emacs-Lisp program data}}
    if {[S 0 == {;ELC\023\000\000\000} ]} {emit {byte-compiled Emacs-Lisp program data}}
    if {[S 0 == {(SYSTEM::VERSION\040'} ]} {emit {CLISP byte-compiled Lisp program text}}
    if {[S 11 == {must\ be\ converted\ with\ BinHex} ]} {emit {BinHex binary text}}
    if {[S 0 == SIT! ]} {emit {StuffIt Archive \(data\)}}
    if {[S 65 == SIT! ]} {emit {StuffIt Archive \(rsrc + data\)}}
    if {[S 0 == SITD ]} {emit {StuffIt Deluxe \(data\)}}
    if {[S 65 == SITD ]} {emit {StuffIt Deluxe \(rsrc + data\)}}
    if {[S 0 == Seg ]} {emit {StuffIt Deluxe Segment \(data\)}}
    if {[S 65 == Seg ]} {emit {StuffIt Deluxe Segment \(rsrc + data\)}}
    if {[S 0 == APPL ]} {emit {Macintosh Application \(data\)}}
    if {[S 65 == APPL ]} {emit {Macintosh Application \(rsrc + data\)}}
    if {[S 0 == zsys ]} {emit {Macintosh System File \(data\)}}
    if {[S 65 == zsys ]} {emit {Macintosh System File\(rsrc + data\)}}
    if {[S 0 == FNDR ]} {emit {Macintosh Finder \(data\)}}
    if {[S 65 == FNDR ]} {emit {Macintosh Finder\(rsrc + data\)}}
    if {[S 0 == libr ]} {emit {Macintosh Library \(data\)}}
    if {[S 65 == libr ]} {emit {Macintosh Library\(rsrc + data\)}}
    if {[S 0 == shlb ]} {emit {Macintosh Shared Library \(data\)}}
    if {[S 65 == shlb ]} {emit {Macintosh Shared Library\(rsrc + data\)}}
    if {[S 0 == cdev ]} {emit {Macintosh Control Panel \(data\)}}
    if {[S 65 == cdev ]} {emit {Macintosh Control Panel\(rsrc + data\)}}
    if {[S 0 == INIT ]} {emit {Macintosh Extension \(data\)}}
    if {[S 65 == INIT ]} {emit {Macintosh Extension\(rsrc + data\)}}
    if {[S 0 == FFIL ]} {emit font/ttf}
    if {[S 65 == FFIL ]} {emit font/ttf}
    if {[S 0 == LWFN ]} {emit font/type1}
    if {[S 65 == LWFN ]} {emit font/type1}
    if {[S 0 == PACT ]} {emit {Macintosh Compact Pro Archive \(data\)}}
    if {[S 65 == PACT ]} {emit {Macintosh Compact Pro Archive\(rsrc + data\)}}
    if {[S 0 == ttro ]} {emit {Macintosh TeachText File \(data\)}}
    if {[S 65 == ttro ]} {emit {Macintosh TeachText File\(rsrc + data\)}}
    if {[S 0 == TEXT ]} {emit {Macintosh TeachText File \(data\)}}
    if {[S 65 == TEXT ]} {emit {Macintosh TeachText File\(rsrc + data\)}}
    if {[S 0 == PDF ]} {emit {Macintosh PDF File \(data\)}}
    if {[S 65 == PDF ]} {emit {Macintosh PDF File\(rsrc + data\)}}
    if {[S 0 == {\#\ Magic} ]} {emit {magic text file for file\(1\) cmd}}
    if {[S 0 == Relay-Version: ]} {emit {old news text}}
    if {[S 0 == {\#!\ rnews} ]} {emit {batched news text}}
    if {[S 0 == {N\#!\ rnews} ]} {emit {mailed, batched news text}}
    if {[S 0 == {Forward\ to} ]} {emit {mail forwarding text}}
    if {[S 0 == {Pipe\ to} ]} {emit {mail piping text}}
    if {[S 0 == Return-Path: ]} {emit message/rfc822}
    if {[S 0 == Path: ]} {emit message/news}
    if {[S 0 == Xref: ]} {emit message/news}
    if {[S 0 == From: ]} {emit message/rfc822}
    if {[S 0 == Article ]} {emit message/news}
    if {[S 0 == BABYL ]} {emit message/x-gnu-rmail}
    if {[S 0 == Received: ]} {emit message/rfc822}
    if {[S 0 == MIME-Version: ]} {emit {MIME entity text}}
    if {[S 0 == {Content-Type:\ } ]} {emit 355}
    if {[S 0 == Content-Type: ]} {emit 356}
    if {[S 0 == {\311\304} ]} {emit {ID tags data}}
    if {[S 0 == {\001\001\001\001} ]} {emit {MMDF mailbox}}
    if {[S 4 == Research, ]} {emit Digifax-G3-File}
    if {[S 0 == RMD1 ]} {emit {raw modem data}}
    if {[S 0 == {PVF1\n} ]} {emit {portable voice format}}
    if {[S 0 == {PVF2\n} ]} {emit {portable voice format}}
    if {[S 0 == S0 ]} {emit {Motorola S-Record; binary data in text format}}
    if {[S 0 == {@echo\ off} ]} {emit {MS-DOS batch file text}}
    if {[S 128 == {PE\0\0} ]} {emit {MS Windows PE}}
    if {[S 0 == MZ ]} {emit application/x-ms-dos-executable}
    if {[S 0 == LZ ]} {emit {MS-DOS executable \(built-in\)}}
    if {[S 0 == regf ]} {emit {Windows NT Registry file}}
    if {[S 2080 == {Microsoft\ Word\ 6.0\ Document} ]} {emit text/vnd.ms-word}
    if {[S 2080 == {Documento\ Microsoft\ Word\ 6} ]} {emit text/vnd.ms-word}
    if {[S 2112 == MSWordDoc ]} {emit text/vnd.ms-word}
    if {[S 0 == PO^Q` ]} {emit text/vnd.ms-word}
    if {[S 2080 == {Microsoft\ Excel\ 5.0\ Worksheet} ]} {emit application/vnd.ms-excel}
    if {[S 2114 == Biff5 ]} {emit application/vnd.ms-excel}
    if {[S 1 == WPC ]} {emit text/vnd.wordperfect}
    switch -- [Nv I 0 &0377777777] 8782091 {emit {NetBSD/i386 demand paged}} 8782088 {emit {NetBSD/i386 pure}} 8782087 {emit NetBSD/i386} 8782151 {emit {NetBSD/i386 core}} 8847627 {emit {NetBSD/m68k demand paged}} 8847624 {emit {NetBSD/m68k pure}} 8847623 {emit NetBSD/m68k} 8847687 {emit {NetBSD/m68k core}} 8913163 {emit {NetBSD/m68k4k demand paged}} 8913160 {emit {NetBSD/m68k4k pure}} 8913159 {emit NetBSD/m68k4k} 8913223 {emit {NetBSD/m68k4k core}} 8978699 {emit {NetBSD/ns32532 demand paged}} 8978696 {emit {NetBSD/ns32532 pure}} 8978695 {emit NetBSD/ns32532} 8978759 {emit {NetBSD/ns32532 core}} 9044235 {emit {NetBSD/sparc demand paged}} 9044232 {emit {NetBSD/sparc pure}} 9044231 {emit NetBSD/sparc} 9044295 {emit {NetBSD/sparc core}} 9109771 {emit {NetBSD/pmax demand paged}} 9109768 {emit {NetBSD/pmax pure}} 9109767 {emit NetBSD/pmax} 9109831 {emit {NetBSD/pmax core}} 9175307 {emit {NetBSD/vax demand paged}} 9175304 {emit {NetBSD/vax pure}} 9175303 {emit NetBSD/vax} 9175367 {emit {NetBSD/vax core}} 9240903 {emit {NetBSD/alpha core}} 9306379 {emit {NetBSD/mips demand paged}} 9306376 {emit {NetBSD/mips pure}} 9306375 {emit NetBSD/mips} 9306439 {emit {NetBSD/mips core}} 9371915 {emit {NetBSD/arm32 demand paged}} 9371912 {emit {NetBSD/arm32 pure}} 9371911 {emit NetBSD/arm32} 9371975 {emit {NetBSD/arm32 core}}
    if {[S 0 == StartFontMetrics ]} {emit font/x-sunos-news}
    if {[S 0 == StartFont ]} {emit font/x-sunos-news}
    switch -- [Nv I 8 ] 326773573 {emit font/x-sunos-news} 326773576 {emit font/x-sunos-news}
    if {[S 0 == Octave-1-L ]} {emit {Octave binary data \(little endian\)}}
    if {[S 0 == Octave-1-B ]} {emit {Octave binary data \(big endian\)}}
    if {[S 0 == {\177OLF} ]} {emit OLF}
    if {[S 0 == %PDF- ]} {emit {PDF document}}
    if {[S 0 == {-----BEGIN\040PGP} ]} {emit {PGP armored data}}
    if {[S 0 == {\#\ PaCkAgE\ DaTaStReAm} ]} {emit {pkg Datastream \(SVR4\)}}
    if {[S 0 == %! ]} {emit application/postscript}
    if {[S 0 == {\004%!} ]} {emit application/postscript}
    if {[S 0 == *PPD-Adobe: ]} {emit {PPD file}}
    if {[S 0 == {\033%-12345X@PJL} ]} {emit {HP Printer Job Language data}}
    if {[S 0 == {\033%-12345X@PJL} ]} {emit {HP Printer Job Language data}}
    if {[S 0 == {\033E\033} ]} {emit image/x-pcl-hp}
    if {[S 0 == @document( ]} {emit {Imagen printer}}
    if {[S 0 == Rast ]} {emit {RST-format raster font data}}
    if {[N I 0 == 0x56000000 &0xff00ffff]} {emit {ps database}}
    if {[S 0 == {\{\\rtf} ]} {emit {Rich Text Format data,}}
    if {[S 38 == Spreadsheet ]} {emit {sc spreadsheet file}}
    if {[S 8 == {\001s\ } ]} {emit {SCCS archive data}}
    switch -- [Nv c 0 ] 38 {emit {Sendmail frozen configuration}} -128 {emit {8086 relocatable \(Microsoft\)}}
    if {[S 0 == kbd!map ]} {emit {kbd map file}}
    if {[S 0 == {\x43\x72\x73\x68\x44\x75\x6d\x70} ]} {emit {IRIX vmcore dump of}}
    if {[S 0 == SGIAUDIT ]} {emit {SGI Audit file}}
    if {[S 0 == WNGZWZSC ]} {emit {Wingz compiled script}}
    if {[S 0 == WNGZWZSS ]} {emit {Wingz spreadsheet}}
    if {[S 0 == WNGZWZHP ]} {emit {Wingz help file}}
    if {[S 0 == {\\#Inventor} ]} {emit {V	IRIS Inventor 1.0 file}}
    if {[S 0 == {\\#Inventor} ]} {emit {V2	Open Inventor 2.0 file}}
    if {[S 0 == {glfHeadMagic();} ]} {emit GLF_TEXT}
    switch -- [Nv I 4 ] 1090584576 {emit GLF_BINARY_LSB_FIRST} 321 {emit GLF_BINARY_MSB_FIRST}
    if {[S 0 == {<!DOCTYPE\ HTML} ]} {emit text/html}
    if {[S 0 == {<!doctype\ html} ]} {emit text/html}
    if {[S 0 == <HEAD ]} {emit text/html}
    if {[S 0 == <head ]} {emit text/html}
    if {[S 0 == <TITLE ]} {emit text/html}
    if {[S 0 == <title ]} {emit text/html}
    if {[S 0 == <html ]} {emit text/html}
    if {[S 0 == <HTML ]} {emit text/html}
    if {[S 0 == <!DOCTYPE ]} {emit {exported SGML document text}}
    if {[S 0 == <!doctype ]} {emit {exported SGML document text}}
    if {[S 0 == <!SUBDOC ]} {emit {exported SGML subdocument text}}
    if {[S 0 == <!subdoc ]} {emit {exported SGML subdocument text}}
    if {[S 0 == <!-- ]} {emit {exported SGML document text}}
    if {[S 0 == RTSS ]} {emit {NetMon capture file}}
    if {[S 0 == {TRSNIFF\ data\ \ \ \ \032} ]} {emit {Sniffer capture file}}
    if {[S 0 == {XCP\0} ]} {emit {NetXRay capture file}}
    if {[S 0 == {<!SQ\ DTD>} ]} {emit {Compiled SGML rules file}}
    if {[S 0 == {<!SQ\ A/E>} ]} {emit {A/E SGML Document binary}}
    if {[S 0 == {<!SQ\ STS>} ]} {emit {A/E SGML binary styles file}}
    if {[S 0 == {SQ\ BITMAP1} ]} {emit {SoftQuad Raster Format text}}
    if {[S 0 == {X\ } ]} {emit {SoftQuad troff Context intermediate}}
    switch -- [Nv I 0 &077777777] 196875 {emit {sparc demand paged}} 196872 {emit {sparc pure}} 196871 {emit sparc} 131339 {emit {mc68020 demand paged}} 131336 {emit {mc68020 pure}} 131335 {emit mc68020} 65803 {emit {mc68010 demand paged}} 65800 {emit {mc68010 pure}} 65799 {emit mc68010}
    if {[S 0 == {\#SUNPC_CONFIG} ]} {emit {SunPC 4.0 Properties Values}}
    if {[S 0 == snoop ]} {emit {Snoop capture file}}
    if {[S 36 == acsp ]} {emit {Kodak Color Management System, ICC Profile}}
    if {[S 0 == {\#!teapot\012xdr} ]} {emit {teapot work sheet \(XDR format\)}}
    if {[S 0 == {\032\001} ]} {emit {Compiled terminfo entry}}
    if {[S 0 == {\367\002} ]} {emit {TeX DVI file}}
    if {[S 0 == {\367\203} ]} {emit font/x-tex}
    if {[S 0 == {\367\131} ]} {emit font/x-tex}
    if {[S 0 == {\367\312} ]} {emit font/x-tex}
    if {[S 0 == {This\ is\ TeX,} ]} {emit {TeX transcript text}}
    if {[S 0 == {This\ is\ METAFONT,} ]} {emit {METAFONT transcript text}}
    if {[S 2 == {\000\021} ]} {emit font/x-tex-tfm}
    if {[S 2 == {\000\022} ]} {emit font/x-tex-tfm}
    if {[S 0 == {\\input\ texinfo} ]} {emit {Texinfo source text}}
    if {[S 0 == {This\ is\ Info\ file} ]} {emit {GNU Info text}}
    if {[S 0 == {\\input} ]} {emit {TeX document text}}
    if {[S 0 == {\\section} ]} {emit {LaTeX document text}}
    if {[S 0 == {\\setlength} ]} {emit {LaTeX document text}}
    if {[S 0 == {\\documentstyle} ]} {emit {LaTeX document text}}
    if {[S 0 == {\\chapter} ]} {emit {LaTeX document text}}
    if {[S 0 == {\\documentclass} ]} {emit {LaTeX 2e document text}}
    if {[S 0 == {\\relax} ]} {emit {LaTeX auxiliary file}}
    if {[S 0 == {\\contentsline} ]} {emit {LaTeX  table of contents}}
    if {[S 0 == {\\indexentry} ]} {emit {LaTeX raw index file}}
    if {[S 0 == {\\begin\{theindex\}} ]} {emit {LaTeX sorted index}}
    if {[S 0 == {\\glossaryentry} ]} {emit {LaTeX raw glossary}}
    if {[S 0 == {\\begin\{theglossary\}} ]} {emit {LaTeX sorted glossary}}
    if {[S 0 == {This\ is\ makeindex} ]} {emit {Makeindex log file}}
    if {[S 0 == **TI82** ]} {emit {TI-82 Graphing Calculator}}
    if {[S 0 == **TI83** ]} {emit {TI-83 Graphing Calculator}}
    if {[S 0 == **TI85** ]} {emit {TI-85 Graphing Calculator}}
    if {[S 0 == **TI92** ]} {emit {TI-92 Graphing Calculator}}
    if {[S 0 == **TI80** ]} {emit {TI-80 Graphing Calculator File.}}
    if {[S 0 == **TI81** ]} {emit {TI-81 Graphing Calculator File.}}
    if {[S 0 == TZif ]} {emit {timezone data}}
    if {[S 0 == {\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1\0} ]} {emit {old timezone data}}
    if {[S 0 == {\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\2\0} ]} {emit {old timezone data}}
    if {[S 0 == {\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\3\0} ]} {emit {old timezone data}}
    if {[S 0 == {\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\4\0} ]} {emit {old timezone data}}
    if {[S 0 == {\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\5\0} ]} {emit {old timezone data}}
    if {[S 0 == {\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\6\0} ]} {emit {old timezone data}}
    if {[S 0 == {.\\\"} ]} {emit {troff or preprocessor input text}}
    if {[S 0 == {'\\\"} ]} {emit {troff or preprocessor input text}}
    if {[S 0 == {'.\\\"} ]} {emit {troff or preprocessor input text}}
    if {[S 0 == {\\\"} ]} {emit {troff or preprocessor input text}}
    if {[S 0 == {x\ T} ]} {emit {ditroff text}}
    if {[S 0 == {\100\357} ]} {emit {very old \(C/A/T\) troff output data}}
    if {[S 0 == Interpress/Xerox ]} {emit {Xerox InterPress data}}
    if {[S 0 == {begin\040} ]} {emit {uuencoded or xxencoded text}}
    if {[S 0 == {xbtoa\ Begin} ]} {emit {btoa'd text}}
    if {[S 0 == {$\012ship} ]} {emit {ship'd binary text}}
    if {[S 0 == {Decode\ the\ following\ with\ bdeco} ]} {emit {bencoded News text}}
    if {[S 11 == {must\ be\ converted\ with\ BinHex} ]} {emit {BinHex binary text}}
    if {[N S 6 == 0x107 ]} {emit {unicos \(cray\) executable}}
    if {[S 596 == {\130\337\377\377} ]} {emit {Ultrix core file}}
    if {[S 0 == Joy!peffpwpc ]} {emit {header for PowerPC PEF executable}}
    if {[S 0 == LBLSIZE= ]} {emit {VICAR image data}}
    if {[S 43 == SFDU_LABEL ]} {emit {VICAR label file}}
    if {[S 0 == {\xb0\0\x30\0} ]} {emit {VMS VAX executable}}
    if {[S 1 == WPC ]} {emit {\(Corel/WP\)}}
    if {[S 0 == core ]} {emit {core file \(Xenix\)}}
    if {[S 0 == {ZyXEL\002} ]} {emit {ZyXEL voice data}}

    result

    return {}
}

## -- ** END GENERATED CODE ** --
## -- Do not edit before this line !
##

# ### ### ### ######### ######### #########
## Ready for use.
# EOF

# -------------------------------------------------------------------------
# Now the package specific tests....

set path [makeFile {} bogus]
removeFile bogus

test fumagic.mimetype-1.1 {test file non-existance} {
    set res [catch {fileutil::magic::mimetype $path} msg]
    list $res $msg
} [list 1 "file not found: \"$path\""]

test fumagic.mimetype-1.2 {test file directory} {
    set f [makeDirectory fileTypeTest]
    set res [catch {fileutil::magic::mimetype $f} msg]
    regsub {file[0-9]+} $msg {fileXXX} msg
    removeDirectory fileTypeTest
    list $res $msg
} {0 application/x-directory}

test fumagic.mimetype-1.3 {test file empty} {
    set f [makeEmptyFile]
    set res [catch {fileutil::magic::mimetype $f} msg]
    removeEmptyFile
    list $res $msg
} {0 {}}

test fumagic.mimetype-1.4 {test simple binary} {
    set f [makeBinFile]
    set res [catch {fileutil::magic::mimetype $f} msg]
    removeBinFile
    list $res $msg
} {0 {}}

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
if {![package vsatisfies [package provide Tcl] 8.6]} {return}

# Recognizers
package ifneeded fileutil::magic::filetype 1.0.2 [list source [file join $dir filetypes.tcl]]
package ifneeded fileutil::magic::filetype 1.1.2 [list source [file join $dir filetypes.tcl]]
package ifneeded fileutil::magic::mimetype 1.0.2 [list source [file join $dir mimetypes.tcl]]

# Runtime
package ifneeded fileutil::magic::rt 1.0 [list source [file join $dir rtcore.tcl]]
package ifneeded fileutil::magic::rt 1.2 [list source [file join $dir rtcore.tcl]]

# Compiler packages
package ifneeded fileutil::magic::cgen   1.0 [list source [file join $dir cgen.tcl]]
package ifneeded fileutil::magic::cfront 1.0 [list source [file join $dir cfront.tcl]]
package ifneeded fileutil::magic::cgen   1.2 [list source [file join $dir cgen.tcl]]
package ifneeded fileutil::magic::cfront 1.2 [list source [file join $dir cfront.tcl]]

#!/bin/sh

# Point this to an unpacked source distribution of file(1) to
# regenerate the recognizers.

filesrc="$1"

mime="${filesrc}/magic/magic.mime"
type="${filesrc}/magic/Magdir"

`dirname $0`/tmc -merge mimetypes.tcl '::fileutil::magic::mimetype::run' "${mime}"
`dirname $0`/tmc -merge filetypes.tcl '::fileutil::magic::filetype::run' "${type}"
`dirname $0`/tmc -merge filetypes.tcl '::fileutil::magic::filetype' "${type}"
exit 0

[package fileutil::magic::filetypes], and the two engine compiler
packages [package fileutil::magic::cgen] and
[package fileutil::magic::cfront].

[section COMMANDS]

[list_begin definitions]

[call [cmd ::fileutil::magic::rt::>]] 

Shorthand for [cmd incr level].

[call [cmd ::fileutil::magic::rt::<]] 

Shorthand for [cmd incr level -1].

[call [cmd ::fileutil::magic::rt::open] [arg filename]]

This command initializes the runtime and prepares the file
[arg filename] for use by the system.

This command has to be invoked first, before any other command of this

[para]

The special comparison operator [const x] signals that no comparison
should be done, or, in other words, that the fetched value will always
match [arg val].

[call [cmd ::fileutil::magic::rt::Nvx] [arg atlevel] [arg type] [arg offset] [opt [arg qual]]]
[call [cmd ::fileutil::magic::rt::Nvx] [arg type] [arg offset] [opt [arg qual]]]

This command behaves like [cmd ::fileutil::magic::rt::Nv], except that
it additionally remembers the location in the file after the fetch in
the calling context, for the level [arg atlevel], for later use by
the calling context, for the current level, for later use by
[cmd ::fileutil::magic::rt::R].

[call [cmd ::fileutil::magic::rt::Nx] [arg atlevel] [arg type] [arg offset] [arg comp] [arg val] [opt [arg qual]]]
[call [cmd ::fileutil::magic::rt::Nx] [arg type] [arg offset] [arg comp] [arg val] [opt [arg qual]]]

This command behaves like [cmd ::fileutil::magic::rt::N], except that
it additionally remembers the location in the file after the fetch in
the calling context, for the level [arg atlevel], for later use by
the calling context, for the current, for later use by
[cmd ::fileutil::magic::rt::R].

[call [cmd ::fileutil::magic::rt::S] [arg offset] [arg comp] [arg val] [opt [arg qual]]]

This command behaves like [cmd ::fileutil::magic::rt::N], except that
it fetches and compares strings, not numeric data. The fetched value
is also stored in the internal string buffer instead of the numeric
buffer.

[call [cmd ::fileutil::magic::rt::Sx] [arg atlevel] [arg offset] [arg comp] [arg val] [opt [arg qual]]]
[call [cmd ::fileutil::magic::rt::Sx] [arg offset] [arg comp] [arg val] [opt [arg qual]]]

This command behaves like [cmd ::fileutil::magic::rt::S], except that
it additionally remembers the location in the file after the fetch in
the calling context, for the level [arg atlevel], for later use by
the calling context, for the current level, for later use by
[cmd ::fileutil::magic::rt::R].

[call [cmd ::fileutil::magic::rt::L] [arg newlevel]]

This command sets the current level in the calling context to
[arg newlevel]. The command returns the empty string as its result.

[para]

In other words, the command computes an absolute location in the file
based on the relative [arg offset] and returns it as its result. The
base the offset is added to is the last location remembered for the
level in the calling context.

[call [cmd ::fileutil::magic::rt::U] [arg fileindex] [arg name]]

Use a named test script at the current level.

[list_end]

[section {NUMERIC TYPES}]

[list_begin definitions]
[def [const byte]]    8-bit integer

# rtcore.tcl --
#
#	Runtime core for file type recognition engines written in pure Tcl.
#
# Copyright (c) 2016      Poor Yorick     <[email protected]>
# Copyright (c) 2004-2005 Colin McCormack <[email protected]>
# Copyright (c) 2005      Andreas Kupries <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: rtcore.tcl,v 1.5 2005/09/28 04:51:19 andreas_kupries Exp $

#####
#
# "mime type recognition in pure tcl"
# http://wiki.tcl.tk/12526
#
# Tcl code harvested on:  10 Feb 2005, 04:06 GMT
# Wiki page last updated: ???
#
#####

#TODO  {
# TODO - Required Functionality:

#    {Required Functionality} {
#	{implement full offset language} {
#	    done
#
# implement full offset language
# implement pstring (pascal string, blerk)
# implement regex form (blerk!)
# implement string qualifiers
#	    by pooryorick
#
#	    time {2016 06}
#	}
#
#	{implement pstring (pascal string, blerk)} {
#	    done
#
#	    by pooryorick
#
#	    time {2016 06}
#}
#
#	{implement regex form (blerk!)} {
#	    done
#
#	    by pooryorick
#
#	    time {2016 06}
#	}

#	{implement string qualifiers} {
#	    done
#	    
#	    by pooryorick
#
#	    time {2016 06}
#	}
#
#	{finish implementing the indirect type}
#
#	{Maybe distinguish between binary and text tests, like file(n)}
#	
#	{process and use strength directives}
#
#    }
#}

# ### ### ### ######### ######### #########
## Requirements

package require Tcl 8.4
package require Tcl 8.6

# ### ### ### ######### ######### #########
## Implementation

namespace eval ::fileutil::magic::rt {
    # Configuration flag. (De)activate debugging output.
    # This is done during initialization.
    # Changes at runtime have no effect.

    variable debug 0

    # The maximum size of a substring to inspect from the file in question 
    variable maxstring 64

    # The maximum length of any %s substitution in a resulting description is
    variable maxpstring 64

    variable regexdefaultlen 4096

    # Runtime state.

    variable cursor 0      ; # The current offset
    variable fd     {}     ; # Channel to file under scrutiny
    variable found 0       ; # Whether the last test produced a match
    variable strbuf {}     ; # Input cache [*].
    variable cache         ; # Cache of fetched and decoded numeric
    array set cache {}	   ; # values.
    variable result {}     ; # Accumulated recognition result.
    variable string {}     ; # Last recognized string | For substitution
    variable numeric -9999 ; # Last recognized number | into the message

    variable extracted     ; # The value extracted for inspection
    variable  last         ; # Behind last fetch locations,
    array set last {}      ; # per nesting level.
    variable weight 0      ; # The weight of the current part. 
                           ; # Basically string length of the contributing of
			   ; # the potentially-matching part.

    variable weighttotal 0 ; # The aggregate weight of the matching components of
			   ; # the current test.

    # [*] The vast majority of magic strings are in the first 4k of the file.

    # Export APIs (full public, recognizer public)
    namespace export open close file_start result
    namespace export emit offset Nv N S Nvx Nx Sx L R I
    namespace export emit ext mime offset Nv N S Nvx Nx Sx L R I resultv U < >
}

# ### ### ### ######### ######### #########
## Public API, general use.

proc ::fileutil::magic::rt::> {} {
    upvar level level
    incr level
}

proc ::fileutil::magic::rt::< {} {
    upvar level level
    incr level -1
}

proc ::fileutil::magic::rt::classify {data} {
    set bin_rx {[\x00-\x08\x0b\x0e-\x1f]}
    if {[regexp $bin_rx $data] } {
        return binary
    } else {
        return text
    }
}

proc ::fileutil::magic::rt::mime value {
    upvar 1 mime mime
    set mime $value
}

proc ::fileutil::magic::rt::ext value {
    upvar 1 ext ext
    set ext $value
}


# open the file to be scanned
proc ::fileutil::magic::rt::open {file} {
    variable result {}
    variable string {}
    variable extracted {} 
    variable numeric -9999
    variable strbuf
    variable fd
    variable cache

    set fd [::open $file]
    ::fconfigure $fd -translation binary

        
    # fill the string cache
    set strbuf [::read $fd 4096]
	set class [classify $strbuf]

    # clear the fetch cache
    catch {unset cache}
    array set cache {}

    return $fd
}


proc ::fileutil::magic::rt::close {} {
    variable fd
    ::close $fd
    return
}

# mark the start of a magic file in debugging
proc ::fileutil::magic::rt::file_start {name} {
    ::fileutil::magic::rt::Debug {puts stderr "File: $name"}
}


# return the emitted result
proc ::fileutil::magic::rt::result {{msg ""}} {
proc ::fileutil::magic::rt::result {{msg {}}} {
    variable found
    variable result
    variable weight
    variable weighttotal
    if {$msg ne ""} {emit $msg}
    return -code return $result
    if {$msg ne {}} {emit $msg}
    set res [list $found $weighttotal $result]
    set found 0
    set weight 0
    set weighttotal 0
    set result {}
    return -code return $res 
}

proc ::fileutil::magic::rt::resultv {{msg ""}} {
    variable result
proc ::fileutil::magic::rt::resultv {{msg {}}} {
    try result on return result {
    if {$msg ne ""} {emit $msg}
    return $result
	return $result
    }
}

# ### ### ### ######### ######### #########
## Public API, for use by a recognizer.

# emit a message
proc ::fileutil::magic::rt::emit {msg} {
    variable string
    variable numeric
    variable result

# emit a description 
proc ::fileutil::magic::rt::emit msg {
    variable found
    variable maxpstring
    variable extracted
    variable result
    set map [list \
	    \\b "" \
		%c [format %c $numeric] \
	    %s  $string \
	    %ld $numeric \
	    %d  $numeric \
	    ]

    lappend result [::string map $map $msg]
    return
}

# handle complex offsets - TODO
proc ::fileutil::magic::rt::offset {where} {
    ::fileutil::magic::rt::Debug {puts stderr "OFFSET: $where"}
    return 0
}

proc ::fileutil::magic::rt::Nv {type offset {qual ""}} {
    variable typemap
    variable numeric

    variable weight
    variable weighttotal
    set found 1
    # unpack the type characteristics
    foreach {size scan} $typemap($type) break

    incr weighttotal $weight
    # fetch the numeric field from the file
    set numeric [Fetch $offset $size $scan]

    #set map [list \
    if {$qual ne ""} {
	# there's a mask to be applied
    #    \\b "" \
    #    %c [apply {extracted {
	set numeric [expr $numeric $qual]
    }

    #        if {[catch {format %c $extracted} result]} {
    ::fileutil::magic::rt::Debug {puts stderr "NV $type $offset $qual: $numeric"}
    return $numeric
}

    #    	return {}
    #        }
    #        return $result

    #    }} $extracted] \
# Numeric - get bytes of $type at $offset and $compare to $val
# qual might be a mask
proc ::fileutil::magic::rt::N {type offset comp val {qual ""}} {
    variable typemap
    variable numeric

    # unpack the type characteristics
    #    %s  [string trim [string range $extracted 0 $maxpstring]] \
    #    %ld $extracted \
    foreach {size scan} $typemap($type) break

    #    %d  $extracted \
    # fetch the numeric field
    set numeric [Fetch $offset $size $scan]

    #]
    # Would moving this before the fetch an optimisation ? The
    # tradeoff is that we give up filling the cache, and it is unclear
    # how often that value would be used. -- Profile!
    if {$comp eq "x"} {
	# anything matches - don't care
	return 1
    }

    #[::string map $map $msg]
    # get value in binary form, then back to numeric
    # this avoids problems with sign, as both values are
    # [binary scan]-converted identically
    binary scan [binary format $scan $val] $scan val

    if {$qual ne ""} {
	# there's a mask to be applied
	set numeric [expr $numeric $qual]
    }

    # {to do} {Is only taking up to the first newline really a good general rule?}
    # perform comparison
    set c [expr $val $comp $numeric]

    regexp {\A[^\n\r]*} $extracted extracted2
    ::fileutil::magic::rt::Debug {puts stderr "numeric $type: $val $comp $numeric / $qual - $c"}
    return $c
}


    regsub -all {\s+} $extracted2 { } extracted2
proc ::fileutil::magic::rt::S {offset comp val {qual ""}} {
    variable fd
    variable string

    # convert any backslashes
    set arguments {}
    set val [subst -nocommands -novariables $val]

    set count [expr {[string length $msg] - [string length [
    if {$comp eq "x"} {
	# match anything - don't care, just get the value
	set string ""

	string map {% {}} $msg]]}]
    for {set i 0} {$i < $count} {incr i} {
	# Query: Can we use GetString here ?
	# Or at least the strbuf cache ?

	# move to the offset
	lappend arguments $extracted2
    }
    catch {set msg [format $msg {*}$arguments]}
	::seek $fd $offset
	while {
	    ([::string length $string] < 100) &&
	    [::string is print [set c [::read $fd 1]]]
	} {
	    if {[::string is space $c]} {
		break
	    }

	    append string $c
	}

    # Assumption: [regexp] leaves $msg untouched if it fails
	return 1
    }

    regexp {\A(\b|\\b)?(.*)$} $msg match b msg
    # get the string and compare it
    set string [GetString $offset [::string length $val]]
    if {$b ne {} && [llength $result]} {
    set cmp    [::string compare $val $string]
    set c      [expr $cmp $comp 0]

	lset result end [lindex $result end]$msg
    ::fileutil::magic::rt::Debug {
	puts "String '$val' $comp '$string' - $c"
	if {$c} {
	    puts "offset $offset - $string"
	}
    } else {
	lappend result $msg
    }
    }
    return $c
    return
}

proc ::fileutil::magic::rt::Nvx {atlevel type offset {qual ""}} {
proc ::fileutil::magic::rt::Nv {type offset compinvert mod mand} {
    variable typemap
    variable numeric
    variable last
    variable extracted
    variable weight

    upvar 1 level l
    set  l $atlevel

    # unpack the type characteristics
    foreach {size scan} $typemap($type) break

    # fetch the numeric field from the file
    set extracted [Fetch $offset $size $scan]

    if {$compinvert && $extracted ne {}} {
	set extracted [expr ~$extracted]
    }
    if {$mod ne {} && $extracted ne {}} {
	# there's a mask to be applied
	set extracted [expr $extracted $mod $mand]
    }

    ::fileutil::magic::rt::Debug {puts stderr "NV $type $offset $mod: $extracted"}
    set weight [string length $extracted]
    return $extracted
}

proc ::fileutil::magic::rt::use {named file name} {
    if [dict exists $named $file $name] {
	set script [dict get $named $file $name]
    } else {
	dict for {file val} $named {
	    if {[dict exists $val $name]} {
		set script [dict get $val $name]
		break
	    }
	}
    }
    if {![info exists script]} {
	return -code error [list {name not found} $key]
    }
    return $script
}

# Numeric - get bytes of $type at $offset and $compare to $val
# qual might be a mask
proc ::fileutil::magic::rt::N {
    type offset testinvert compinvert mod mand comp val} {
    variable typemap
    variable extracted
    variable weight

    # unpack the type characteristics
    foreach {size scan} $typemap($type) break

    # fetch the numeric field
    set numeric [Fetch $offset $size $scan]
    set extracted [Fetch $offset $size $scan]
    if {$extracted eq {}} {

    set last($atlevel) [expr {$offset + $size}]
	# Rules like the following, from the jpeg file, imply that
	# in the absence of an extracted value, a numerical value of 
	# 0 should be used

    if {$qual ne ""} {
	# there's a mask to be applied
	set numeric [expr $numeric $qual]
	# From jpeg:
	    ## Next, show thumbnail info, if it exists:
	    #>>18    byte        !0      \b, thumbnail %dx
	set extracted 0
    }

    ::fileutil::magic::rt::Debug {puts stderr "NV $type $offset $qual: $numeric"}
    return $numeric
}

# Numeric - get bytes of $type at $offset and $compare to $val
# qual might be a mask
proc ::fileutil::magic::rt::Nx {atlevel type offset comp val {qual ""}} {
    # Would moving this before the fetch an optimisation ? The
    # tradeoff is that we give up filling the cache, and it is unclear
    # how often that value would be used. -- Profile!
    if {$comp eq {x}} {
	set weight 0
	# anything matches - don't care
	if {$testinvert} {
	    return 0
	} else {
	    return 1
	}
    }

    if {[string match $scan *me]} {
	set data [me4 $data]
	set scan I 
    variable typemap
    variable numeric
    variable last

    upvar 1 level l
    set  l $atlevel

    # unpack the type characteristics
    foreach {size scan} $typemap($type) break

    set last($atlevel) [expr {$offset + $size}]

    # fetch the numeric field
    set numeric [Fetch $offset $size $scan]

    if {$comp eq "x"} {
	# anything matches - don't care
	return 1
    }
    # get value in binary form, then back to numeric
    # this avoids problems with sign, as both values are
    # [binary scan]-converted identically (see [treegen1])
    binary scan [binary format $scan $val] $scan val

    if {$compinvert && $extracted ne {}} {
	set extracted [expr ~$extracted]
    }

    # perform comparison
    if {$mod ne {}} {
	# there's a mask to be applied
	set extracted [expr $extracted $mod $mand]
    }
    switch $comp {
	& {
	    set c [expr {($extracted & $val) == $val}]
	}
	^ {
	    set c [expr {($extracted & ~$val) == $extracted}]
	}
	== - != - < - > {
	    set c [expr $extracted $comp $val]
	}
	default {
	    #Should never reach this
	    return -code error [list {unknown comparison operator} $comp]
	}
    }
    # Do this last to minimize shimmering
    set weight [string length $extracted]

    ::fileutil::magic::rt::Debug {
	puts stderr "numeric $type: $val $t$comp $extracted / $mod - $c"
    }
    if {$testinvert} {
	set c [expr {!$c}]
	return $c 
    } else {
	return $c
    }

    # get value in binary form, then back to numeric
    # this avoids problems with sign, as both values are
    # [binary scan]-converted identically
    binary scan [binary format $scan $val] $scan val

    if {$qual ne ""} {
}

proc ::fileutil::magic::rt::S {type offset testinvert mod mand comp val} {
    variable cursor
    variable extracted
    variable fd
    variable maxstring
    variable regexdefaultlen
    variable weight

    # $compinvert is currently ignored for strings

    set weight [string length $val]

    switch $type {
	pstring {
	    set ptype B
	    set vincluded 0
	    # The last pstring type specifier wins 
	    foreach item $mod {
		if {$item eq {J}} {
		    set vincluded 1
		} else {
		    set ptype $item
		}
	    }
	    lassign [dict get {B {b 1} H {S 2} h {s 2} L {I 4} l {i 4}} $ptype] scan slength
	    set length [GetString $offset $slength]
	    set offset $cursor 
	    binary scan $length ${scan}u length
	    if {$vincluded} {
	# there's a mask to be applied
	set numeric [expr $numeric $qual]
    }

    # perform comparison
    set c [expr $val $comp $numeric]

		set length [expr {$length - $slength}]
	    }
	    set extracted [GetString $offset $length]
	    set c [Smatch $val $comp $extracted $mod]
	}
	regex {
	    if {$mand eq {}} {
		set mand $regexdefaultlen 
	    }
	    set extracted [GetString $offset $mand]
	    if {[regexp $val $extracted match]} {
		set weight [string length $match]
	        set c 1
	    } else {
	        set c 0
	    }
    ::fileutil::magic::rt::Debug {puts stderr "numeric $type: $val $comp $numeric / $qual - $c"}
    return $c
}

proc ::fileutil::magic::rt::Sx {atlevel offset comp val {qual ""}} {
    variable fd
    variable string
    variable last

    upvar 1 level l
    set  l $atlevel

	}
	search {
	    set limit $mand
	    set extracted [GetString $offset $limit]
	    if {[string first $val $extracted] >= 0} {
		set weight [string length $val]
		set c 1
	    } else {
		set c 0
	    }
	} default {
	    # get the string and compare it
	    switch $type bestring16 - lestring16 {
		set extracted [GetString $offset $maxstring]
		set extracted [string range $extracted 0 1]
		switch $type bestring16 {
		    set extracted [binary scan $extracted Su]
		} lestring16 {
		    set extracted [binary scan $extracted Su]
		}
		set extracted [format %c $extracted]
	    } default {
		# If $val is 0, give [emit] something to work with .
		if {$val eq  "\0"} {
		    set extracted [GetString $offset $maxstring]
		} else {
		    set extracted [GetString $offset [string length $val]]
		}
	    }
	    set c [Smatch $val $comp $extracted $mod]
	}
    }


    ::fileutil::magic::rt::Debug {
	puts "String '$val' $comp '$extracted' - $c"
	if {$c} {
	    puts "offset $offset - $extracted"
	}
    }
    if {$testinvert} {
	return [expr {!$c}]
    } else {
	return $c
    }
}

proc ::fileutil::magic::rt::Smatch {val op string mod} {
    variable weight
    if {$op eq {x}} {
	set weight 0
	return 1
    }

    if {![string length $string]} {
	# Nothing matches an empty $string.
	return 0
    }
    # convert any backslashes
    set val [subst -nocommands -novariables $val]

    if {$comp eq "x"} {
	# match anything - don't care, just get the value
	set string ""

	# Query: Can we use GetString here ?
	# Or at least the strbuf cache ?

	# move to the offset
	::seek $fd $offset
	while {
	    ([::string length $string] < 100) &&
	    [::string is print [set c [::read $fd 1]]]
	} {
	    if {[::string is space $c]} {
    if {$op eq {>} && [string length $val] > [string length $string]} {
	return 1
    }

    # To preserve the semantics, the w operation must occur prior to the W
    # operation (Assuming the interpretation that w makes all whitespace
    # optional, relazing the requirements of W) .
    if {{w} in $mod} {
	regsub -all {\s} $string[set string {}] {} string
	regsub -all {\s} $val[set val {}] {} val
    }

    if {{W} in $mod} {
	set blanklen [::tcl::mathfunc::max 0 {*}[
	    lmap blanks [lrange [regexp -all -inline {(\s+)} $val] 1 end] {
	    expr {[$lindex blanks 1] - [$lindex blanks 0]}
	}]]
	if {![regexp "\s{$blanklen}" $string]} {
	    ::fileutil::magic::rt::Debug {
		puts "String '$val' $op '$string' - $c"
		if {$c} {
		    puts "offset $offset - $string"
		}
	    }
	    return 0
	}

	regsub -all {\s+} $string[set string {}] { } string
	regsub -all {\s+} $val[set val {}] { } val
    }


    if {{T} in $mod} {
	set string [string trim $string[set string {}]]
	set val [string tolower $val[set val {}]]
    }

    set string [string range $string  0 [string length $val]-1]

    # The remaining code may assume that $string and $val have the same length
    # .

		break
	    }
	    append string $c
	}

	set last($atlevel) [expr {$offset + [string length $string]}]

	return 1
    }
    set opnum [dict get {< -1 == 0 eq 0 != 0 ne 0 > 1} $op]

    if {{c} in $mod || {C} in $mod} {
	if {{c} in $mod && {C} in $mod} {
	    set string [string tolower $string[set string {}]]
	    set val [string tolower $val[set val {}]]
	} elseif {{c} in $mod} {
	    foreach sc [split $string] vc [split $val] {
		if {[string is lower $sc]} {
		    set vc [string tolower $vc]
		}
		if {[::string compare $val $string] != $opnum} {
		    set res 0
		    break
		}
	    }
	} elseif {{C} in $mode} {
	    foreach vc [split $val] sc [split $string]  {
		if {[string is upper $vc]} {
		    set sc [string toupper $sc]
		}
		if {[::string compare $val $string] != $opnum} {
		    set res 0
		    break
		}
	    }
	}
    } else {
	set res [expr {[::string compare $string $val] == $opnum}]
    }
    if {$op in {!= ne}} {
	set res [expr {!$res}]
    }
    set weight [string length $val]
    return $res
}

proc ::fileutil::magic::rt::Nvx {type offset compinvert mod mand} {
    variable typemap
    variable extracted
    variable last
    variable weight
    set len [::string length $val]
    set last($atlevel) [expr {$offset + $len}]

    upvar 1 level l
    # unpack the type characteristics
    foreach {size scan} $typemap($type) break
    set last($l) [expr {$offset + $size}]

    set extracted [Nv $type $offset $compinvert $mod $mand]
    # get the string and compare it
    set string [GetString $offset $len]
    set cmp    [::string compare $val $string]
    set c      [expr $cmp $comp 0]

    ::fileutil::magic::rt::Debug {puts stderr "NVx $type $offset $extracted $mod $mand"}
    return $extracted
}

# Numeric - get bytes of $type at $offset and $compare to $val
# qual might be a mask
proc ::fileutil::magic::rt::Nx {
    type offset testinvert compinvert mod mand comp val} {

    variable cursor
    variable typemap
    variable extracted
    variable last
    variable weight

    upvar 1 level l

    set res [N $type $offset $testinvert $compinvert $mod $mand $comp $val]

    ::fileutil::magic::rt::Debug {
	puts stderr "Nx numeric $type: $val $comp $extracted / $qual - $c"
    }
	puts "String '$val' $comp '$string' - $c"
	if {$c} {
	    puts "offset $offset - $string"
	}
    }
    return $c
    set last($l) $cursor
    return $res
}

proc ::fileutil::magic::rt::Sx {
    type offset testinvert mod mand comp val} {
    variable cursor
    variable extracted
    variable fd
    variable last
    variable weight

    upvar 1 level l

    set res [S $type $offset $testinvert $mod $mand $comp $val]
    set last($l) $cursor
    return $res
}
proc ::fileutil::magic::rt::L {newlevel} {
    # Regenerate level information in the calling context.
    upvar 1 level l ; set l $newlevel
    return
}

proc ::fileutil::magic::rt::I {base type delta} {
proc ::fileutil::magic::rt::I {offset it ioi ioo iir io} {
    # Handling of base locations specified indirectly through the
    # contents of the inspected file.

    variable typemap
    foreach {size scan} $typemap($type) break
    return [expr {[Fetch $base $size $scan] + $delta}]
}

proc ::fileutil::magic::rt::R {base} {
    foreach {size scan} $typemap($it) break
    if {$iir} {
	set io [Fetch [expr $offset + $io] $size $scan]
    }
    set data [Fetch [expr $offset $ioo $io] $size $scan]

    if {$ioi} {
	set data [expr {~$data}]
    }
    if {$ioo ne {}} {
	set data [expr $data $ioo $io]
    }
    return $data
}

proc ::fileutil::magic::rt::R base {
    # Handling of base locations specified relative to the end of the
    # last field one level above.

    variable last   ; # Remembered locations.
    upvar 1 level l ; # The level to get data from.
    return [expr {$last($l) + $base}]
    return [expr {$last([expr {$l-1}]) + $base}]
}


proc ::fileutil::magic::rt::U {file name} {
    upvar level l
    upvar named named
    set script [use $named $file $name]
    tailcall ::try $script
}

# ### ### ### ######### ######### #########
## Internal. Retrieval of the data used in comparisons.

# fetch and cache a numeric value from the file
proc ::fileutil::magic::rt::Fetch {where what scan} {
    variable cache
    variable numeric
    variable cursor
    variable extracted
    variable strbuf
    variable fd

    # {to do} id3 length
    if {![info exists cache($where,$what,$scan)]} {
	::seek $fd $where
	binary scan [::read $fd $what] $scan numeric
	set cache($where,$what,$scan) $numeric
	set data [::read $fd $what]
	incr cursor [string length $data]
	set extracted [rtscan $data $scan]
	set cache($where,$what,$scan) [list $extracted $cursor]

	# Optimization: If we got 4 bytes, i.e. long we implicitly
	# know the short and byte data as well. Should put them into
	# the cache. -- Profile: How often does such an overlap truly
	# happen ?

    } else {
	set numeric $cache($where,$what,$scan)
	lassign $cache($where,$what,$scan) extracted cursor
    }
    return $extracted
}

proc ::fileutil::magic::rt::rtscan {data scan} {
    if {$scan eq {me}} {
	set data [me4 $data]
	set scan I 
    }
    set numeric {}
    binary scan $data $scan numeric
    return $numeric
}

proc ::fileutil::magic::rt::GetString {offset len} {
    # We have the first 1k of the file cached
    variable string
proc ::fileutil::magic::rt::me4 data {
	binary scan $data a4 chars
	set data [binary format a4 [lindex $chars 1] [
	lindex $chars 0] [lindex $chars 3] [lindex $chars 2]]
}

proc ::fileutil::magic::rt::GetString {offset len} {
    variable cursor
    # We have the first 1k of the file cached
    variable strbuf
    variable fd

    set end [expr {$offset + $len - 1}]
    if {$end < 4096} {
	# in the string cache, copy the requested part.
	set string [::string range $strbuf $offset $end]
    } else {
	# an unusual one, move to the offset and read directly from
	# the file.
	::seek $fd $offset
	set string [::read $fd $len]
    }
    set cursor [expr {$offset + [string length $string]}]
    return $string
}

# ### ### ### ######### ######### #########
## Internal, debugging.

if {!$::fileutil::magic::rt::debug} {

    variable typemap
    global tcl_platform

    # Set the definitions for all types which have their endianess
    # explicitly specified n their name.

    array set typemap {
	byte    {1 c}  ubyte    {1 c}
	beshort {2 S}  ubeshort {2 S}
	leshort {2 s}  uleshort {2 s}
	belong  {4 I}  ubelong  {4 I}
	lelong  {4 i}  ulelong  {4 i}  
	byte    {1 c}
	beshort {2 S}
	leshort {2 s}
	bedouble {8 Q}
	belong  {4 I}
	lelong  {4 i}
	bedate  {4 S}  ledate   {4 s}
	beldate {4 I}  leldate  {4 i}
	bedouble {8 Q}
	beqdate {8 W}
	beqldate {8 W}
	bequad {8 W} 
	ledouble {8 q}
	leqdate {8 w}
	leqldate {8 w}
	lequad {8 w}
	lequad {8 w} 
	leqwdate {8 w}
	medate  {4 me}
	melong  {4 me}
	meldate  {4 me}
	lestring16 {2 s}
	bestring16 {2 S}

	long  {4 Q} ulong  {4 Q} date  {4 Q} ldate {4 Q}
	short {2 Y} ushort {2 Y}
	long  {4 Q} date  {4 Q} ldate {4 Q}
	short {2 Y} quad {8 W} 
    }

    # Now set the definitions for the types without explicit
    # endianess. They assume/use 'native' byteorder. We also put in
    # special forms for the compiler, so that it can use short names
    # for the native-endian types as well.

    # generate short form names
    foreach {n v} [array get typemap] {
	foreach {len scan} $v break
	#puts stderr "Adding $scan - [list $len $scan]"
	set typemap($scan) [list $len $scan]
    }

    # The special Q and Y short forms are incorrect, correct now to
    # use the proper native endianess.

    # {to do} {Is ldate done correctly in the procedure?  What is its byte
    # order anyway?  Native?}

    if {$tcl_platform(byteOrder) eq "littleEndian"} {
	array set typemap {Q {4 i} Y {2 s}}
	array set typemap {Q {4 i} Y {2 s}
	    short {2 s} long {4 i} quad {8 w}
	}
    } else {
	array set typemap {Q {4 I} Y {2 S}}
	array set typemap {Q {4 I} Y {2 S}
	    short {2 S} long {4 I} quad {8 W}
	}
    }
}

::fileutil::magic::rt::Init
# ### ### ### ######### ######### #########
## Ready for use.

package provide fileutil::magic::rt 1.0
package provide fileutil::magic::rt 1.2
# EOF

#! /bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# TMC - Trival Magic Compiler
# === = =====================

# Use cases
# ---------
 
# (-)	Compilation of one or more files in magic(5) syntax into a
#	single recognizer performing all the checks and mappings
#	list of recognizers performing all the checks and mappings
#	encoded in them.
# 
# Command syntax
# --------------
# 
# Ad 1)	tmc procname magic-file ?magic-file...?
# Ad 1)	tmc namespace magic-file ?magic-file...?
#
#	Compile all magic files into a recognizer, put it into the
#	named procedure, and write the result to stdout.
#	Compile all magic files list of recognizers, generate a script which
#	assigns the recognizers to $namespace::tests and $namespace::named and
#	write the script to stdout.
# 
# Ad 2)	tmc -merge tclfile procname magic-file ?magic-file...?
# Ad 2)	tmc -merge tclfile namespace magic-file ?magic-file...?
#
#	Same as (1), but does not write to stdout. Instead the part of
#	the 'tclfile' delineated by marker lines containing "BEGIN
#	GENERATED CODE" and "END GENERATED CODE" is replaced with the
#	generated code.

package require Tcl 8.4
lappend auto_path [file dirname [file normalize [info script]]] ; # This directory
lappend auto_path [file dirname [lindex $auto_path end]]        ; # and the one above
set auto_path [linsert $auto_path 0 [file dirname [file normalize [info script]]]] ; # This directory
set auto_path [linsert $auto_path 0 [file dirname [lindex $auto_path end]]]]        ; # and the one above
#puts *\t[join $auto_path \n*\t]
package require fileutil::magic::cfront

# ### ### ### ######### ######### #########
## Internal data and status

namespace eval ::tmc {

##

proc ::tmc::processCmdline {} {
    global argv

    variable output
    variable magic
    variable proc
    variable namespace

    set output ""
    set magic  {}
    set proc   ""
    set namespace ""

    # Process the options, perform basic validation.

    while {[llength $argv]} {
	set opt [lindex $argv 0]
	if {![string match "-*" $opt]} break
	if {$opt eq "-merge"} {
	    if {[llength $argv] < 2} Usage
	    set output [lindex $argv 1]
	    set argv   [lrange $argv 2 end]
	} else {
	    Usage
	}
    }

    # Additional validation, and extraction of the non-option
    # arguments.

    if {[llength $argv] != 2} Usage

    set proc  [lindex $argv 0]
    set namespace  [lindex $argv 0]
    set magic [lrange $argv 1 end]

    # Final validation across the whole configuration.

    if {$proc eq ""} {
	ArgError "Illegal empty proc name"
    if {$namespace eq ""} {
	ArgError "Illegal empty namespace name"
    }
    foreach m $magic {
	CheckInput $m {Magic file}
    }
    if {$output ne ""} {
	CheckTheMerge
    }

# Both write their messages to stderr and then
# exit the application with status 1.
##

proc ::tmc::Usage {} {
    global argv0
    puts stderr "$argv0 wrong#args, expected:\
	    ?-merge iofile? procname magic magic..."
	    ?-merge iofile? namespace magic magic..."
    exit 1
}

proc ::tmc::ArgError {text} {
    global argv0
    puts stderr "$argv0: $text"
    exit 1

}

# ### ### ### ######### ######### #########
## Invoking the functionality.

if {[catch {
    # Read and process all input files.
    # Generate a single tcl procedure from them.
    # Generate commands into a namespace.
    # Write the result either to stdout, or merge
    # into the specified output file.

    set tcl [eval [linsert $tmc::magic 0 \
	    fileutil::magic::cfront::procdef \
	    $tmc::proc]]
	    fileutil::magic::cfront::generate \
	    $tmc::namespace]]

    if {$tmc::output eq ""} {
	puts stdout $tcl
    } else {
	::tmc::Merge $tmc::output \n${tcl}\n
    }
} msg]} {
    puts $::errorInfo
    ::tmc::ArgError $msg
}

# ### ### ### ######### ######### #########
exit