Posted to tcl by Florentis at Fri Oct 16 04:41:23 GMT 2026view raw

  1. # executable.tcl --
  2. #
  3. # FR : Le type « fichier exécutable » complet : une SOMME de deux formats,
  4. # ELF (executable_elf.tcl) et PE (executable_pe.tcl). Le type de la
  5. # somme dit de quel format il s'agit ; le reste du code n'a besoin
  6. # que de la structure commune : des sections (les sommets) et des
  7. # hyperarêtes (segments ELF, répertoires PE) sous forme de masques de
  8. # bits. L'analyse d'hypergraphe est donc écrite UNE seule fois.
  9. # EN : The complete "executable file" type: a SUM of two formats, ELF
  10. # (executable_elf.tcl) and PE (executable_pe.tcl). The sum's type says
  11. # which format it is; the rest of the code only needs the common
  12. # structure: sections (the vertices) and hyperedges (ELF segments, PE
  13. # directories) as bit masks. The hypergraph analysis is therefore
  14. # written ONCE.
  15. #
  16. # usage : tclsh executable.tcl ?file ...? (default: the running tclsh)
  17. # try : tclsh executable.tcl /bin/ls some.exe other.dll
  18.  
  19. # FR : on charge les deux lecteurs (leur programme principal ne se lance pas)
  20. # EN : load the two readers (their main program does not run)
  21. set ici [file dirname [file normalize [info script]]]
  22. source [file join $ici executable_elf.tcl]
  23. source [file join $ici executable_pe.tcl]
  24.  
  25. # ---------------------------------------------------------------------------
  26. # FR : Les types / EN: The types
  27. # ---------------------------------------------------------------------------
  28.  
  29. # FR : la somme : un exécutable est SOIT un elf(n) SOIT un pe(n), avec le
  30. # même n (nombre de sections). Le nom de variante est le nom de champ.
  31. # EN : the sum: an executable is EITHER an elf(n) OR a pe(n), with the same
  32. # n (number of sections). The variant name is the field name.
  33. type def {executable({int}n)} {{elf($n)}elf, {pe($n)}pe}
  34.  
  35. # FR : l'hypergraphe générique de hypergraphe.tcl (labels = sommets,
  36. # edges = hyperarêtes), qui sert aux deux formats.
  37. # EN : the generic hypergraph of hypergraphe.tcl (labels = vertices,
  38. # edges = hyperedges), shared by both formats.
  39. type def {hg({int}n)} {{list($n).string}labels; {list.bitarray($n)}edges}
  40.  
  41. # ---------------------------------------------------------------------------
  42. # FR : Lecture : détecte le format et rend une valeur executable(n)
  43. # EN : Reading: detects the format and returns an executable(n) value
  44. # ---------------------------------------------------------------------------
  45.  
  46. proc lire_executable {chemin} {
  47. set f [open $chemin rb]
  48. set debut [read $f 4]
  49. close $f
  50. if {$debut eq "\x7fELF"} {
  51. lassign [lire_elf $chemin] n valeurs
  52. set champs {bits endian machine entry sections segments couverture}
  53. set variante elf
  54. } elseif {[string range $debut 0 1] eq "MZ"} {
  55. lassign [lire_pe $chemin] n valeurs
  56. set champs {bits machine fichier dllcar subsystem entry imagebase
  57. sections repertoires couverture}
  58. set variante pe
  59. } else {
  60. error "$chemin: format inconnu / unknown format"
  61. }
  62. # FR : le nom des types contient n : on construit les commandes en texte
  63. # EN : type names contain n: the commands are built as text
  64. set cmd "set {${variante}($n)}V"
  65. foreach champ $champs v $valeurs {append cmd " " [list $champ $v]}
  66. eval $cmd
  67. eval "set {executable($n)}X {$variante}\$V"
  68. return $X
  69. }
  70.  
  71. # ---------------------------------------------------------------------------
  72. # FR : Accès communs / EN: Common accessors
  73. # ---------------------------------------------------------------------------
  74.  
  75. # FR : variante d'une valeur somme : « executable(31).elf » -> « elf »
  76. # EN : variant of a sum value: "executable(31).elf" -> "elf"
  77. proc variante {x} {
  78. lindex [split [type get $x] .] end
  79. }
  80.  
  81. # FR : sections en lecture/écriture/exécution, selon le format
  82. # EN : sections' read/write/execute rights, depending on the format
  83. proc droits {x i} {
  84. set v [variante $x]
  85. if {$v eq "elf"} {
  86. # FR : ELF : le droit est porté par le segment LOAD qui contient la section
  87. # EN : ELF: the right belongs to the LOAD segment holding the section
  88. set d "---"
  89. for {set s 0} {$s < [llength $x($v.segments)]} {incr s} {
  90. if {$x($v.segments.$s.genre) eq "LOAD" && $x($v.couverture.$s.$i)} {
  91. set p $x($v.segments.$s.perms)
  92. set d "[expr {$p(2) ? "R" : "-"}][expr {$p(1) ? "W" : "-"}][expr {$p(0) ? "X" : "-"}]"
  93. }
  94. }
  95. return $d
  96. } else {
  97. # FR : PE : le droit est dans les drapeaux de la section
  98. # EN : PE: the right is in the section's flags
  99. set f $x($v.sections.$i.flags)
  100. return "[expr {$f(30) ? "R" : "-"}][expr {$f(31) ? "W" : "-"}][expr {$f(29) ? "X" : "-"}]"
  101. }
  102. }
  103.  
  104. # FR : le nom commun des hyperarêtes : segment ELF ou répertoire PE
  105. # EN : the common name of hyperedges: ELF segment or PE directory
  106. proc nom_arete {x j} {
  107. set v [variante $x]
  108. if {$v eq "elf"} {return "$x($v.segments.$j.genre)#$j"}
  109. return $x($v.repertoires.$j.nom)
  110. }
  111.  
  112. # FR : construit l'hypergraphe hg(n) des deux formats (une seule fois)
  113. # EN : builds the hg(n) hypergraph for both formats (once)
  114. proc hypergraphe_de {x} {
  115. set v [variante $x]
  116. set n [llength $x($v.sections)]
  117. set noms [lmap s $x($v.sections) {expr {[lindex $s 0] eq "" ? "(null)" : [lindex $s 0]}}]
  118. set cmd "set {hg($n)}H labels [list $noms] edges [list $x($v.couverture)]"
  119. eval $cmd
  120. return $H
  121. }
  122.  
  123. # ---------------------------------------------------------------------------
  124. # FR : Analyse d'hypergraphe : indépendante du format
  125. # EN : Hypergraph analysis: independent of the format
  126. # ---------------------------------------------------------------------------
  127.  
  128. proc analyser {x} {
  129. set v [variante $x]
  130. set H [hypergraphe_de $x]
  131. set n [llength $H(labels)]
  132. set m [llength $H(edges)]
  133.  
  134. # FR : sections qui ne sont dans aucune hyperarête (non chargées / sans répertoire)
  135. # EN : sections in no hyperedge (not loaded / no directory)
  136. set union 0
  137. for {set j 0} {$j < $m} {incr j} {set union [expr {$union | $H(edges.$j)}]}
  138. set hors [expr {$union ^ ((1 << $n) - 1)}]
  139. set liste {}
  140. for {set i 0} {$i < $n} {incr i} {
  141. if {($hors >> $i) & 1} {lappend liste [lindex $H(labels) $i]}
  142. }
  143. puts " [expr {popcount($hors)}] section(s) in no hyperedge: $liste"
  144.  
  145. # FR : section dans le plus d'hyperarêtes = la plus « centrale »
  146. # EN : section in the most hyperedges = the most "central"
  147. set best -1
  148. set meilleure ""
  149. for {set i 0} {$i < $n} {incr i} {
  150. set deg 0
  151. for {set j 0} {$j < $m} {incr j} {incr deg $H(edges.$j.$i)}
  152. if {$deg > $best} {set best $deg; set meilleure [lindex $H(labels) $i]}
  153. }
  154. puts " most central section: $meilleure (degree $best)"
  155.  
  156. # FR : l'hyperarête la plus grande / EN: the biggest hyperedge
  157. set grand -1
  158. for {set j 0} {$j < $m} {incr j} {
  159. set t [expr {popcount($H(edges.$j))}]
  160. if {$t > $grand} {set grand $t; set jg $j}
  161. }
  162. puts " biggest hyperedge: [nom_arete $x $jg] ($grand sections)"
  163.  
  164. # FR : paires d'hyperarêtes qui partagent le plus de sections
  165. # EN : pair of hyperedges sharing the most sections
  166. set maxc 0
  167. set paire ""
  168. for {set a 0} {$a < $m} {incr a} {
  169. for {set b [expr {$a + 1}]} {$b < $m} {incr b} {
  170. set c [expr {popcount($H(edges.$a) & $H(edges.$b))}]
  171. if {$c > $maxc} {set maxc $c; set paire "[nom_arete $x $a] & [nom_arete $x $b]"}
  172. }
  173. }
  174. puts " most overlapping pair: [expr {$paire eq "" ? "none" : "$paire ($maxc sections)"}]"
  175. }
  176.  
  177. # FR : contrôles spécifiques d'un format, choisis par la VARIANTE de la somme
  178. # EN : format-specific checks, selected by the sum's VARIANT
  179. proc controles {x} {
  180. set v [variante $x]
  181. switch $v {
  182. elf {
  183. set wx {}
  184. for {set s 0} {$s < [llength $x(elf.segments)]} {incr s} {
  185. if {($x(elf.segments.$s.perms) & 3) == 3} {lappend wx $s}
  186. }
  187. puts " W^X: [expr {[llength $wx] ? "VIOLATION $wx" : "ok"}]"
  188. }
  189. pe {
  190. set aslr [expr {$x(pe.dllcar.6) ? "yes" : "no"}]
  191. set dep [expr {$x(pe.dllcar.8) ? "yes" : "no"}]
  192. puts " ASLR: $aslr DEP: $dep [expr {$x(pe.fichier.13) ? "DLL" : "EXE"}]"
  193. }
  194. }
  195. }
  196.  
  197. # ---------------------------------------------------------------------------
  198. # FR : Programme principal / EN: Main program
  199. # ---------------------------------------------------------------------------
  200.  
  201. # FR : une procédure par fichier : x est typé executable(n), et un n différent
  202. # par fichier interdirait de réutiliser la même variable globale.
  203. # EN : one procedure per file: x is typed executable(n), and a different n per
  204. # file would forbid reusing the same global variable.
  205. proc rapporter {chemin} {
  206. set x [lire_executable $chemin]
  207. set v [variante $x]
  208. puts "\n=== [file tail $chemin] ==="
  209. puts "type: [type get $x] format: [string toupper $v]$x($v.bits) $x($v.machine)"
  210. puts "entry: [format 0x%x $x($v.entry)]"
  211. controles $x
  212. puts "sections (first 6):"
  213. for {set i 0} {$i < 6 && $i < [llength $x($v.sections)]} {incr i} {
  214. puts [format " %2d %-22s %s" $i $x($v.sections.$i.nom) [droits $x $i]]
  215. }
  216. puts "hypergraph:"
  217. analyser $x
  218. }
  219.  
  220. set fichiers [expr {$argc ? $argv : [list [info nameofexecutable]]}]
  221. foreach chemin $fichiers {rapporter $chemin}

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week