From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Sat, 12 Jun 2021 14:06:33 +0000 (+1000)
Subject: another example
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=97bcab28825fde3e717ac5489b0f3f19e5e3f5db;p=rrq%2Frrqforth.git

another example
---

diff --git a/examples/uenventlog.f b/examples/uenventlog.f
new file mode 100755
index 0000000..ff69c48
--- /dev/null
+++ b/examples/uenventlog.f
@@ -0,0 +1,63 @@
+#!/home/ralph/src/devuan/rrqforth/rrqforth
+#
+# Register a netlink socket and listen to events
+
+SYSTEM DEFINITIONS
+
+# For deugging purposes, use log" blaha"
+: log" " TELL NL EMIT ;
+
+: VARIABLE ( "word" -- ; create a variable )
+  INPUT @ READ-WORD CREATE DROP
+;
+
+: CONSTANT ( v "word" -- ; create a cell constant )
+  INPUT @ READ-WORD CREATE TFA>CFA doVALUE SWAP ! ,
+;
+
+: DIE" ( n " quoted" -- ; If v then print message and exit )
+  " ROT IF TELL NL EMIT EXIT THEN 2DROP
+;
+
+HEX 100 DECIMAL   CONSTANT MSG_WAITALL
+HEX 80002 DECIMAL CONSTANT SOCK_DGRAM|SOCK_CLOEXEC
+15                CONSTANT NETLINK_KOBJECT_UEVENT
+16                CONSTANT AF_NETLINK
+8192              CONSTANT NL_MAX_PAYLOAD
+
+VARIABLE RECV-BUFFER NL_MAX_PAYLOAD ALLOT
+
+: PRINTMSG ( n -- ; print RECV-BUFFER message )
+  ( n is message length when >0 but we only use text up to first NUL )
+  DUP 0 >
+  IF DROP RECV-BUFFER DUP STRLEN TELL NL EMIT
+  ELSE S" ** Error: " TELL . NL EMIT
+  THEN
+;
+
+VARIABLE NL-SOCKADDR
+( 0-1 .family )  AF_NETLINK W,
+( 2-3 ??? )       0 W,
+( 4-7 .pid )     SYS_GETPID D,
+( 8-11 .groups ) -1 D,
+12 CONSTANT NL_SOCKADDR_SIZE
+VARIABLE NL-SOCKET -1 ,
+
+AF_NETLINK  SOCK_DGRAM|SOCK_CLOEXEC  NETLINK_KOBJECT_UEVENT
+SYS_SOCKET DUP 0< DIE" Failed to create socket" NL-SOCKET !
+
+NL-SOCKET @ NL-SOCKADDR NL_SOCKADDR_SIZE
+SYS_BIND DIE" Failed to bind"
+
+: NL-LOOP
+  BEGIN
+    NL-SOCKET @ RECV-BUFFER NL_MAX_PAYLOAD MSG_WAITALL 0 0
+    SYS_RECVFROM PRINTMSG
+  AGAIN
+;
+
+log" Waiting for uevents..."
+NL-LOOP
+
+# Won't come here, but so what?
+0 EXIT