Posted to tcl by Florentis at Fri Oct 16 04:39:33 GMT 2026view raw

  1. # executable_pe.tcl --
  2. #
  3. # FR : Un type « fichier exécutable » pour le format PE (Windows : .exe, .dll).
  4. # Même démarche que executable_elf.tcl : lecture avec binary scan,
  5. # types produit, bitarray pour les drapeaux, hypergraphe pour les liens.
  6. # EN : An "executable file" type for the PE format (Windows: .exe, .dll).
  7. # Same approach as executable_elf.tcl: reading with binary scan,
  8. # product types, bitarray for flags, hypergraph for the relations.
  9. #
  10. # usage : tclsh executable_pe.tcl file.exe
  11. #
  12. # FR : Différences avec ELF :
  13. # - les drapeaux sont plus nombreux : 16 bits (caractéristiques du
  14. # fichier, du DLL) et 32 bits (caractéristiques de section) ;
  15. # - l'hypergraphe est différent : les sommets sont les sections, les
  16. # hyperarêtes sont les 16 « répertoires de données » (imports, exports,
  17. # ressources, relocations...). Un répertoire peut couvrir plusieurs
  18. # sections, et une section en contient plusieurs ;
  19. # - PE32 (32 bits) et PE32+ (64 bits) ont des en-têtes de tailles
  20. # différentes, d'où un seul type pe(n) et deux chemins de lecture.
  21. # EN: Differences from ELF:
  22. # - more flags: 16 bits (file and DLL characteristics) and 32 bits
  23. # (section characteristics);
  24. # - a different hypergraph: vertices are sections, hyperedges are the 16
  25. # "data directories" (imports, exports, resources, relocations...).
  26. # A directory can span several sections, and a section holds several;
  27. # - PE32 (32-bit) and PE32+ (64-bit) have headers of different sizes, hence
  28. # one type pe(n) and two reading paths.
  29.  
  30. # ---------------------------------------------------------------------------
  31. # FR : Les types / EN: The types
  32. # ---------------------------------------------------------------------------
  33.  
  34. type def sectionpe {
  35. {string}nom;
  36. {bitarray(32)}flags; # bit5 CODE, bit6 INIT_DATA, bit7 UNINIT_DATA,
  37. # bit29 EXECUTE, bit30 READ, bit31 WRITE
  38. {int}vaddr; {int}vsize; {int}rawptr; {int}rawsize
  39. }
  40. type def repertoire {{string}nom; {int}rva; {int}taille}
  41. # FR : n = nombre de sections (les sommets) / EN: n = number of sections (the vertices)
  42. type def {pe({int}n)} {
  43. {int}bits; {string}machine;
  44. {bitarray(16)}fichier; # bit1 EXECUTABLE_IMAGE, bit5 LARGE_ADDRESS_AWARE, bit13 DLL
  45. {bitarray(16)}dllcar; # bit5 HIGH_ENTROPY_VA, bit6 DYNAMIC_BASE (ASLR),
  46. # bit8 NX_COMPAT (DEP), bit14 GUARD_CF
  47. {string}subsystem; {int}entry; {int}imagebase;
  48. {list($n).sectionpe}sections;
  49. {list.repertoire}repertoires;
  50. {list.bitarray($n)}couverture ;# FR: un masque par répertoire / EN: one mask per directory
  51. }
  52.  
  53. # ---------------------------------------------------------------------------
  54. # FR : Lecture binaire / EN: Binary reading
  55. # ---------------------------------------------------------------------------
  56.  
  57. # FR : lirele data off w1 w2... : entiers non signés little-endian (PE l'est toujours)
  58. # EN : lirele data off w1 w2... : unsigned little-endian integers (PE always is)
  59. proc lirele {data off args} {
  60. set fmt "@$off"
  61. set names {}
  62. set i 0
  63. foreach w $args {
  64. append fmt [dict get {1 cu 2 su 4 iu 8 wu} $w]
  65. lappend names v$i
  66. incr i
  67. }
  68. binary scan $data $fmt {*}$names
  69. lmap v $names {set $v}
  70. }
  71.  
  72. set MACHINES_PE {332 x86 34404 x86-64 452 ARM 43620 ARM64 512 IA-64}
  73. set SUBSYSTEMS {1 native 2 GUI 3 console 9 WinCE 10 EFI-app 14 Xbox}
  74. set REPERTOIRES {Export Import Resource Exception Security BaseReloc Debug
  75. Architecture GlobalPtr TLS LoadConfig BoundImport IAT DelayImport CLR
  76. Reserved}
  77.  
  78. proc nom_de {table code} {
  79. expr {[dict exists $table $code] ? [dict get $table $code] : "0x[format %x $code]"}
  80. }
  81.  
  82. # ---------------------------------------------------------------------------
  83. # FR : Lecture d'un fichier PE / EN: Reading a PE file
  84. # ---------------------------------------------------------------------------
  85.  
  86. proc lire_pe {chemin} {
  87. global MACHINES_PE SUBSYSTEMS REPERTOIRES
  88. set f [open $chemin rb]
  89. set data [read $f]
  90. close $f
  91.  
  92. # FR : en-tête DOS puis signature « PE\0\0 » / EN: DOS header then "PE\0\0" signature
  93. if {[string range $data 0 1] ne "MZ"} {error "$chemin: not a PE file (no MZ)"}
  94. set pe [lindex [lirele $data 60 4] 0]
  95. if {[string range $data $pe [expr {$pe + 3}]] ne "PE\x00\x00"} {
  96. error "$chemin: no PE signature"
  97. }
  98.  
  99. # FR : en-tête COFF / EN: COFF header
  100. lassign [lirele $data [expr {$pe + 4}] 2 2 4 4 4 2 2] \
  101. machine nsec - - - taille_opt caract
  102. set opt [expr {$pe + 24}]
  103. set magic [lindex [lirele $data $opt 2] 0]
  104. switch $magic {
  105. 267 {set bits 32}
  106. 523 {set bits 64}
  107. default {error "$chemin: unknown optional header magic $magic"}
  108. }
  109. # FR : PE32 et PE32+ ne placent pas les champs aux mêmes endroits
  110. # EN : PE32 and PE32+ do not place the fields at the same offsets
  111. set entry [lindex [lirele $data [expr {$opt + 16}] 4] 0]
  112. if {$bits == 64} {
  113. set base [lindex [lirele $data [expr {$opt + 24}] 8] 0]
  114. set dirs [expr {$opt + 112}]
  115. set nd [lindex [lirele $data [expr {$opt + 108}] 4] 0]
  116. } else {
  117. set base [lindex [lirele $data [expr {$opt + 28}] 4] 0]
  118. set dirs [expr {$opt + 96}]
  119. set nd [lindex [lirele $data [expr {$opt + 92}] 4] 0]
  120. }
  121. lassign [lirele $data [expr {$opt + 68}] 2 2] sub dllcar
  122.  
  123. # FR : répertoires de données / EN: data directories
  124. set repertoires {}
  125. for {set i 0} {$i < $nd && $i < 16} {incr i} {
  126. lassign [lirele $data [expr {$dirs + 8 * $i}] 4 4] rva tai
  127. lappend repertoires [list [lindex $REPERTOIRES $i] $rva $tai]
  128. }
  129.  
  130. # FR : table des sections, juste après l'en-tête optionnel
  131. # EN : section table, right after the optional header
  132. set sections {}
  133. set st [expr {$opt + $taille_opt}]
  134. for {set i 0} {$i < $nsec} {incr i} {
  135. set o [expr {$st + 40 * $i}]
  136. binary scan $data "@${o}a8" nom
  137. set nom [string trimright $nom "\x00"]
  138. lassign [lirele $data [expr {$o + 8}] 4 4 4 4] vsize va rsize rptr
  139. set fl [lindex [lirele $data [expr {$o + 36}] 4] 0]
  140. lappend sections [list $nom $fl $va $vsize $rptr $rsize]
  141. }
  142. set couv [remplir_couverture_pe $sections $repertoires]
  143. return [list $nsec [list $bits [nom_de $MACHINES_PE $machine] $caract $dllcar \
  144. [nom_de $SUBSYSTEMS $sub] $entry $base $sections $repertoires $couv]]
  145. }
  146.  
  147. # FR : le répertoire r couvre la section s s'ils se recouvrent en mémoire
  148. # (RVA) : hyperarête = ensemble des sections touchées.
  149. # EN : directory r covers section s if they overlap in memory (RVA):
  150. # hyperedge = set of touched sections.
  151. proc remplir_couverture_pe {sections repertoires} {
  152. set masques {}
  153. foreach r $repertoires {
  154. lassign $r nom rva tai
  155. set m 0
  156. set i 0
  157. foreach s $sections {
  158. lassign $s snom fl va vsize
  159. if {$tai > 0 && $rva < $va + $vsize && $rva + $tai > $va} {
  160. set m [expr {$m | (1 << $i)}]
  161. }
  162. incr i
  163. }
  164. lappend masques $m
  165. }
  166. return $masques
  167. }
  168.  
  169. # FR : le programme principal ne s'exécute que si ce fichier est lancé
  170. # directement (pas quand il est chargé par source depuis executable.tcl).
  171. # EN : the main program only runs when this file is launched directly
  172. # (not when sourced from executable.tcl).
  173. if {[file normalize [info script]] eq [file normalize $argv0]} {
  174. # ---------------------------------------------------------------------------
  175. # FR : Programme principal / EN: Main program
  176. # ---------------------------------------------------------------------------
  177.  
  178. if {$argc < 1} {puts stderr "usage: tclsh executable_pe.tcl file.exe"; exit 2}
  179. lassign [lire_pe [lindex $argv 0]] n valeurs
  180.  
  181. # FR : le nom du type contient n, donc on construit la commande en texte.
  182. # EN : the type name contains n, so the command is built as text.
  183. set cmd "set {pe($n)}E"
  184. foreach champ {bits machine fichier dllcar subsystem entry imagebase
  185. sections repertoires couverture} v $valeurs {
  186. append cmd " " [list $champ $v]
  187. }
  188. eval $cmd
  189.  
  190. puts "type : [type get $E]"
  191. puts "PE$E(bits) $E(machine), subsystem $E(subsystem), entry RVA [format 0x%x $E(entry)],\
  192. image base [format 0x%x $E(imagebase)]"
  193. puts "[expr {$E(fichier.13) ? "DLL" : "EXE"}]\
  194. [expr {$E(fichier.5) ? "(large address aware)" : ""}]"
  195.  
  196. # FR : mitigations de sécurité, lues bit par bit dans dllcar
  197. # EN : security mitigations, read bit by bit in dllcar
  198. puts "\n--- FR: mitigations / EN: mitigations ---"
  199. foreach {bit nom} {5 HIGH_ENTROPY_VA 6 "DYNAMIC_BASE (ASLR)" 8 "NX_COMPAT (DEP)" 14 GUARD_CF} {
  200. puts [format " %-22s %s" $nom [expr {$E(dllcar.$bit) ? "yes" : "no"}]]
  201. }
  202.  
  203. # FR : droits d'une section : les 3 bits hauts du bitarray(32)
  204. # EN : section rights: the 3 high bits of the bitarray(32)
  205. proc rwx {fl} {
  206. return "[expr {$fl(30) ? "R" : "-"}][expr {$fl(31) ? "W" : "-"}][expr {$fl(29) ? "X" : "-"}]"
  207. }
  208. proc noms_sections {E masque} {
  209. set out {}
  210. for {set i 0} {$i < [llength $E(sections)]} {incr i} {
  211. if {($masque >> $i) & 1} {lappend out $E(sections.$i.nom)}
  212. }
  213. return $out
  214. }
  215.  
  216. puts "\n--- FR: sections / EN: sections ---"
  217. for {set i 0} {$i < [llength $E(sections)]} {incr i} {
  218. puts [format " %-8s %s rva %#8x size %#8x" $E(sections.$i.nom) \
  219. [rwx $E(sections.$i.flags)] $E(sections.$i.vaddr) $E(sections.$i.vsize)]
  220. }
  221.  
  222. puts "\n--- FR: répertoires -> sections / EN: directories -> sections ---"
  223. for {set i 0} {$i < [llength $E(repertoires)]} {incr i} {
  224. if {$E(repertoires.$i.taille) > 0} {
  225. puts [format " %-10s rva %#8x size %#6x : %s" $E(repertoires.$i.nom) \
  226. $E(repertoires.$i.rva) $E(repertoires.$i.taille) \
  227. [join [noms_sections $E $E(couverture.$i)] " "]]
  228. }
  229. }
  230.  
  231. # FR : sections qui contiennent plus d'un répertoire (degré >= 2)
  232. # EN : sections holding more than one directory (degree >= 2)
  233. puts "\n--- FR: sections partagées / EN: shared sections ---"
  234. for {set k 0} {$k < [llength $E(sections)]} {incr k} {
  235. set qui {}
  236. for {set i 0} {$i < [llength $E(couverture)]} {incr i} {
  237. if {$E(couverture.$i.$k)} {lappend qui $E(repertoires.$i.nom)}
  238. }
  239. if {[llength $qui] >= 2} {
  240. puts " $E(sections.$k.nom) : [join $qui {, }]"
  241. }
  242. }
  243.  
  244. # ---------------------------------------------------------------------------
  245. # FR : contrôles entre champs / EN: cross-field checks
  246. # ---------------------------------------------------------------------------
  247.  
  248. puts "\n--- FR: contrôles / EN: checks ---"
  249.  
  250. # FR : W^X sur les sections / EN: W^X on sections
  251. set wx {}
  252. for {set i 0} {$i < [llength $E(sections)]} {incr i} {
  253. # FR : bits 29 et 31 ensemble : EXECUTE et WRITE
  254. # EN : bits 29 and 31 together: EXECUTE and WRITE
  255. if {$E(sections.$i.flags.29) && $E(sections.$i.flags.31)} {
  256. lappend wx $E(sections.$i.nom)
  257. }
  258. }
  259. puts "W^X : [expr {[llength $wx] ? "VIOLATION $wx" : "ok"}]"
  260.  
  261. # FR : le point d'entrée tombe-t-il dans une section exécutable ?
  262. # EN : does the entry point fall in an executable section?
  263. set ok 0
  264. for {set i 0} {$i < [llength $E(sections)]} {incr i} {
  265. set va $E(sections.$i.vaddr)
  266. if {$E(entry) >= $va && $E(entry) < $va + $E(sections.$i.vsize)} {
  267. set ok $E(sections.$i.flags.29)
  268. puts "entry point : in $E(sections.$i.nom) ([rwx $E(sections.$i.flags)])"
  269. }
  270. }
  271. if {!$ok && $E(entry) != 0} {puts "entry point : PROBLEM"}
  272.  
  273. puts "\n--- FR: refus du typage / EN: what typing refuses ---"
  274. # FR : attention, ne pas réutiliser une variable typée pour un message
  275. # (ici m1, m2 sont des variables fraîches).
  276. # EN : careful, do not reuse a typed variable for a message (m1, m2 are fresh).
  277. catch {set {repertoire}R nom Import rva abc taille 0} m1
  278. puts "rva not an integer : $m1"
  279. catch {set {sectionpe}S nom .text flags 0x100000000 vaddr 0 vsize 0 rawptr 0 rawsize 0} m2
  280. puts "flags too wide : $m2"
  281. }

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