basis/unix/utmpx/utmpx.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types alien.data alien.syntax combinators
   4 continuations io.encodings.string io.encodings.utf8 kernel
   5 sequences strings calendar system accessors unix unix.time
   6 unix.ffi calendar.unix vocabs.loader classes.struct ;
   7 IN: unix.utmpx
   8
   9 CONSTANT: EMPTY 0
  10 CONSTANT: RUN_LVL 1
  11 CONSTANT: BOOT_TIME 2
  12 CONSTANT: OLD_TIME 3
  13 CONSTANT: NEW_TIME 4
  14 CONSTANT: INIT_PROCESS 5
  15 CONSTANT: LOGIN_PROCESS 6
  16 CONSTANT: USER_PROCESS 7
  17 CONSTANT: DEAD_PROCESS 8
  18 CONSTANT: ACCOUNTING 9
  19 CONSTANT: SIGNATURE 10
  20 CONSTANT: SHUTDOWN_TIME 11
  21
  22 C-TYPE: utmpx
  23
  24 FUNCTION: void setutxent ( ) ;
  25 FUNCTION: void endutxent ( ) ;
  26 FUNCTION: utmpx* getutxent ( ) ;
  27 FUNCTION: utmpx* getutxid ( utmpx* id ) ;
  28 FUNCTION: utmpx* getutxline ( utmpx* line ) ;
  29 FUNCTION: utmpx* pututxline ( utmpx* utx ) ;
  30
  31 TUPLE: utmpx-record user id line pid type timestamp host ;
  32
  33 HOOK: new-utmpx-record os ( -- utmpx-record )
  34
  35 HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record )
  36
  37 : memory>string ( alien n -- string )
  38     memory>byte-array utf8 decode [ 0 = ] trim-tail ;
  39
  40 M: unix new-utmpx-record
  41     utmpx-record new ;
  42
  43 M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
  44     [ new-utmpx-record ] dip
  45     {
  46         [ ut_user>> _UTX_USERSIZE memory>string >>user ]
  47         [ ut_id>>   _UTX_IDSIZE memory>string >>id ]
  48         [ ut_line>> _UTX_LINESIZE memory>string >>line ]
  49         [ ut_pid>>  >>pid ]
  50         [ ut_type>> >>type ]
  51         [ ut_tv>>   timeval>unix-time >>timestamp ]
  52         [ ut_host>> _UTX_HOSTSIZE memory>string >>host ]
  53     } cleave ;
  54
  55 : with-utmpx ( quot -- )
  56     setutxent [ endutxent ] [ ] cleanup ; inline
  57
  58 : all-utmpx ( -- seq )
  59     [
  60         [ getutxent dup ]
  61         [ utmpx>utmpx-record ]
  62         produce nip
  63     ] with-utmpx ;
  64
  65 os {
  66     { macosx [ "unix.utmpx.macosx" require ] }
  67     { netbsd [ "unix.utmpx.netbsd" require ] }
  68 } case