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