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