]> gitweb.factorcode.org Git - factor.git/blob - basis/unix/utmpx/utmpx.factor
move some allocation words that don't really have much to do with c types out of...
[factor.git] / 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 unix calendar system accessors unix.time
6 calendar.unix vocabs.loader ;
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 FUNCTION: void setutxent ( ) ;
23 FUNCTION: void endutxent ( ) ;
24 FUNCTION: utmpx* getutxent ( ) ;
25 FUNCTION: utmpx* getutxid ( utmpx* id ) ;
26 FUNCTION: utmpx* getutxline ( utmpx* line ) ;
27 FUNCTION: utmpx* pututxline ( utmpx* utx ) ;
28
29 TUPLE: utmpx-record user id line pid type timestamp host ;
30
31 HOOK: new-utmpx-record os ( -- utmpx-record )
32
33 HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record )
34
35 : memory>string ( alien n -- string )
36     memory>byte-array utf8 decode [ 0 = ] trim-tail ;
37
38 M: unix new-utmpx-record
39     utmpx-record new ;
40     
41 M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
42     [ new-utmpx-record ] dip
43     {
44         [ utmpx-ut_user _UTX_USERSIZE memory>string >>user ]
45         [ utmpx-ut_id _UTX_IDSIZE memory>string >>id ]
46         [ utmpx-ut_line _UTX_LINESIZE memory>string >>line ]
47         [ utmpx-ut_pid >>pid ]
48         [ utmpx-ut_type >>type ]
49         [ utmpx-ut_tv timeval>unix-time >>timestamp ]
50         [ utmpx-ut_host _UTX_HOSTSIZE memory>string >>host ]
51     } cleave ;
52
53 : with-utmpx ( quot -- )
54     setutxent [ endutxent ] [ ] cleanup ; inline
55
56 : all-utmpx ( -- seq )
57     [
58         [ getutxent dup ]
59         [ utmpx>utmpx-record ]
60         produce nip
61     ] with-utmpx ;
62     
63 os {
64     { macosx [ "unix.utmpx.macosx" require ] }
65     { netbsd [ "unix.utmpx.netbsd" require ] }
66 } case