correction
[rrq/rrqforth.git] / examples / uenventlog.f
1 #!/home/ralph/src/devuan/rrqforth/rrqforth
2 #
3 # Register a netlink socket and listen to events
4
5 SYSTEM DEFINITIONS
6
7 # For deugging purposes, use log" blaha"
8 : log" " TELL NL EMIT ;
9
10 : VARIABLE ( "word" -- ; create a variable )
11   INPUT @ READ-WORD CREATE DROP
12 ;
13
14 : CONSTANT ( v "word" -- ; create a cell constant )
15   INPUT @ READ-WORD CREATE TFA>CFA doVALUE SWAP ! ,
16 ;
17
18 : DIE" ( n " quoted" -- ; If v then print message and exit )
19   " ROT IF TELL NL EMIT 1 EXIT THEN 2DROP
20 ;
21
22 : time ( -- s ; seconds since epoch )
23   0 SYS_TIME
24 ;
25
26 HEX 100 DECIMAL   CONSTANT MSG_WAITALL
27 HEX 80002 DECIMAL CONSTANT SOCK_DGRAM|SOCK_CLOEXEC
28 15                CONSTANT NETLINK_KOBJECT_UEVENT
29 16                CONSTANT AF_NETLINK
30 8192              CONSTANT NL_MAX_PAYLOAD
31
32 VARIABLE RECV-BUFFER NL_MAX_PAYLOAD ALLOT
33
34 VARIABLE NL-SOCKADDR
35 ( 0-1 .family )  AF_NETLINK W,
36 ( 2-3 ??? )       0 W,
37 ( 4-7 .pid )     SYS_GETPID D,
38 ( 8-11 .groups ) -1 D,
39 12 CONSTANT NL_SOCKADDR_SIZE
40 VARIABLE NL-SOCKET -1 ,
41
42 AF_NETLINK  SOCK_DGRAM|SOCK_CLOEXEC  NETLINK_KOBJECT_UEVENT
43 SYS_SOCKET DUP 0< DIE" Failed to create socket" NL-SOCKET !
44
45 NL-SOCKET @ NL-SOCKADDR NL_SOCKADDR_SIZE
46 SYS_BIND DIE" Failed to bind"
47
48 : NL-LOOP
49   BEGIN
50     NL-SOCKET @ RECV-BUFFER NL_MAX_PAYLOAD MSG_WAITALL 0 0
51     SYS_RECVFROM DUP 0 >
52     IF DROP time . SP EMIT RECV-BUFFER DUP STRLEN TELL NL EMIT
53     ELSE S" ** Error: " TELL . NL EMIT
54     THEN
55   AGAIN
56 ;
57
58 log" Waiting for uevents..."
59 NL-LOOP
60
61 # Won't come here, but so what?
62 0 EXIT