extra/broadcast-server/broadcast-server.factor

   1 ! Copyright (C) 2021 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs calendar combinators
   4 continuations destructors io io.encodings.string
   5 io.encodings.utf8 io.files.info io.sockets io.streams.string
   6 kernel layouts make parser prettyprint prettyprint.config
   7 sequences splitting system system-info threads ;
   8 IN: broadcast-server
   9
  10 TUPLE: broadcast-server < disposable
  11     broadcast-inet4
  12     receive-inet4
  13     should-stop?
  14     received
  15     broadcast-socket
  16     receive-socket ;
  17
  18 : <broadcast-server> ( broadcast-ip port -- obj )
  19     broadcast-server new-disposable
  20         over f swap <inet4> >>receive-inet4
  21         -rot <inet4> >>broadcast-inet4
  22         H{ } clone >>received ; inline
  23
  24 M: broadcast-server dispose*
  25     [ receive-socket>> dispose ]
  26     [ broadcast-socket>> dispose ] bi ;
  27
  28 : broadcast-server-send ( bytes type broadcast-server -- )
  29     [ 2array unparse utf8 encode ] dip
  30     [ broadcast-inet4>> ] [ broadcast-socket>> ] bi send ;
  31
  32 SINGLETONS: command data ;
  33
  34 : send-broadcast-command ( str server -- )
  35     [ command ] dip broadcast-server-send ;
  36
  37 : send-broadcast-data ( str server -- )
  38     [ data ] dip broadcast-server-send ;
  39
  40 : run-command ( string -- out )
  41     [ parse-lines [ [ call( -- ) ] with-string-writer ] without-limits ]
  42     [ drop ] recover ;
  43
  44 : handle-data ( data inet4 broadcast-server -- )
  45     [ received>> push-at ]
  46     [
  47         [ . ] dip
  48         swap dup ...
  49         first
  50         unclip-last {
  51             { data [ 2drop ] }
  52             { command [ run-command swap send-broadcast-data ] }
  53             [ unparse "unknown command: " prepend print 2drop ]
  54         } case
  55         nl
  56     ] 3bi ;
  57
  58 : receive-loop ( broadcast-server -- )
  59     '[
  60         [
  61             _ dup should-stop?>> [
  62                 dispose f
  63             ] [
  64                 [
  65                     receive-socket>> receive
  66                     [ utf8 decode split-lines parse-lines ] dip
  67                 ] keep handle-data t
  68             ] if
  69         ] loop
  70     ] in-thread ;
  71
  72 : payload ( -- byte-array )
  73     [
  74         computer-name "computer-name" ,,
  75         os unparse "os" ,,
  76         os-version "os-version" ,,
  77         cpu unparse "cpu" ,,
  78         cell-bits "cell-bits" ,,
  79         username "username" ,,
  80
  81         build "build" ,,
  82         vm-git-id "git-id" ,,
  83         version-info "version-info" ,,
  84         vm-path "vm-path" ,,
  85         vm-path file-info size>> "vm-size" ,,
  86         image-path "image-path" ,,
  87         image-path file-info size>> "image-size" ,,
  88
  89         cpus "cpus" ,,
  90         cpu-mhz "cpu-mhz" ,,
  91         physical-mem "physical-mem" ,,
  92         vm-path file-system-info
  93         [ total-space>> "disk-total-size" ,, ]
  94         [ free-space>> "disk-free-size" ,, ] bi
  95     ] { } make ;
  96
  97 : send-loop ( broadcast-server -- )
  98     '[
  99         [
 100             _ dup should-stop?>> [
 101                 dispose f
 102             ] [
 103                 payload data rot broadcast-server-send t
 104             ] if
 105             3 seconds sleep
 106         ] loop
 107     ] in-thread ;
 108
 109 : start-broadcast-server ( ip port -- obj )
 110     [
 111         <broadcast-server>
 112             dup receive-inet4>> <datagram> |dispose >>receive-socket
 113             dup broadcast-inet4>> <any-port-local-broadcast> |dispose >>broadcast-socket
 114         [ receive-loop ]
 115         [ send-loop ]
 116         [ ] tri
 117     ] with-destructors ;
 118
 119 ! "192.168.88.255" 7777 start-broadcast-server
 120 ! "USE: math 2 2 + ." over send-broadcast-command