extra/ldcache/ldcache.factor

   1 ! Copyright (C) 2017 Björn Lindqvist.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.strings assocs byte-arrays
   4 classes.struct continuations io io.encodings.binary
   5 io.encodings.string io.files kernel math math.bitwise sequences
   6 system ;
   7 IN: ldcache
   8
   9 ! General util
  10 ERROR: bad-magic got expected ;
  11
  12 : check-magic ( got expected -- )
  13     2dup = [ 2drop ] [ bad-magic ] if ;
  14
  15 CONSTANT: HEADER_MAGIC_OLD "ld.so-1.7.0"
  16 CONSTANT: HEADER_MAGIC_NEW "glibc-ld.so.cache1.1"
  17
  18 TUPLE: ldcache-entry elf? arch osversion hwcap key value ;
  19
  20 STRUCT: HeaderOld
  21     { magic char[11] }
  22     { nlibs uint32_t } ;
  23
  24 STRUCT: EntryOld
  25     { flags int32_t }
  26     { key uint32_t }
  27     { value uint32_t } ;
  28
  29 STRUCT: HeaderNew
  30     { magic char[20] }
  31     { nlibs uint32_t }
  32     { stringslen uint32_t }
  33     { unused uint32_t[5] } ;
  34
  35 STRUCT: EntryNew
  36     { flags int16_t }
  37     { key uint32_t }
  38     { value uint32_t }
  39     { osversion uint32_t }
  40     { hwcap uint64_t } ;
  41
  42 : check-ldcache-magic ( header expected -- )
  43     [ magic>> ] dip [ >byte-array ] bi@ check-magic ;
  44
  45 : make-string ( string-table i -- str )
  46     0 spin [ index-from ] 2keep swapd subseq
  47     native-string-encoding decode ;
  48
  49 : string-offset ( header-new -- n )
  50     nlibs>> EntryNew struct-size * HeaderNew struct-size + ;
  51
  52 : subtract-string-offset ( ofs entry-new -- entry-new )
  53     over '[ _ - ] change-key swap '[ _ - ] change-value ;
  54
  55 : parse-new-entries ( header-new -- seq )
  56     [ string-offset ] keep
  57     nlibs>> [ EntryNew read-struct ] replicate
  58     [ subtract-string-offset ] with map ;
  59
  60 : flag>arch ( flag -- arch )
  61     0xff00 bitand
  62     { { 0x0800 x86.32 }
  63       { 0x0300 x86.64 }
  64       { 0x0500 ppc.64 }
  65     } at ;
  66
  67 : <ldcache-entry> ( string-table entry-new -- entry )
  68     [
  69         nip [
  70             flags>> [ 1 mask? ] [ flag>arch ] bi
  71         ] [ osversion>> ] [ hwcap>> ] tri
  72     ]
  73     [ key>> make-string ]
  74     [ value>> make-string ] 2tri ldcache-entry boa ;
  75
  76 : parse ( -- entries  )
  77     ! Read the old header and jump past it.
  78     HeaderOld read-struct
  79     [
  80         [ HEADER_MAGIC_OLD check-ldcache-magic ]
  81         [ nlibs>> EntryOld struct-size * seek-relative seek-input ] bi
  82     ] [ 2drop HeaderOld struct-size neg seek-relative seek-input ] recover
  83     HeaderNew read-struct
  84     [ HEADER_MAGIC_NEW check-ldcache-magic ] keep
  85     [ parse-new-entries ]
  86     [ stringslen>> read ] bi
  87     swap [ <ldcache-entry> ] with map ;
  88
  89 : search ( entries namespec arch -- entry/f )
  90     swap "lib" ".so" surround '[ [ arch>> _ = ] [ key>> _ head? ] bi and ] find nip ;
  91
  92 : find-so ( namespec -- so-name/f )
  93     [ "/etc/ld.so.cache" binary [ parse ] with-file-reader ] dip
  94     cpu search [ key>> ] [ f ] if* ;