diff --git a/pkg/hs/vere/Vere/Behn.hs b/pkg/hs/vere/Vere/Behn.hs new file mode 100644 index 000000000..f53bd370b --- /dev/null +++ b/pkg/hs/vere/Vere/Behn.hs @@ -0,0 +1,109 @@ +{- + # Behn + + This provides a timer. To use this, + + - Create a new timer with `init`. + - Use `doze` to start the timer. + - Call `wait` to wait until the timer fires. + + Then, `wait` will return when the specified time has come. + + - If the specified time was in the past, `wait` will return immediately. + - If a timer is set again, the old timer will not fire. The new time + replaces the old one. + - If a timer is unset (with `doze _ Nothing`), the timer will not fire + until a new time has been set. + + ## Implementation Notes + + We use `tryPutMVar` when the timer fires, so that things will continue + to work correctly if the user does not call `wait`. If a timer fires + before `wait` is called, `wait` will return immediatly. + + To handle race conditions, the MVar in `bState` is used as a lock. The + code for setting a timer and the thread that runs when the timer fires + (which causes `wait` to return) both take that MVar before acting. + + So, if the timer fires conncurently with a call to `doze`, + then one of those threads will get the lock and the other will wait: + + - If the `doze` call gets the lock first, it will kill the timer thread + before releasing it. + - If the timer gets the the lock first, it will fire (causeing `wait` + to return) first, and then `doze` action will wait until that finishes. +-} + +module Vere.Behn (Behn, init, wait, doze) where + +import Control.Concurrent +import Control.Concurrent.Async hiding (wait) +import Control.Concurrent.MVar +import Data.LargeWord +import Prelude hiding (init) + +import Data.Time.Clock.System (SystemTime(..), getSystemTime) +import Control.Lens ((&)) +import Control.Monad (void) + + +-- Time Stuff ------------------------------------------------------------------ + +type UrbitTime = Word128 + +urNow :: IO UrbitTime +urNow = systemTimeToUrbitTime <$> getSystemTime + +{- + TODO This is wrong. + + - The high word should be `(0x8000000cce9e0d80ULL + secs)` + - The low word should be `(((usecs * 65536ULL) / 1000000ULL) << 48ULL)` +-} +systemTimeToUrbitTime :: SystemTime -> UrbitTime +systemTimeToUrbitTime (MkSystemTime secs ns) = + LargeKey (fromIntegral secs) (fromIntegral ns) + +-- TODO +urbitTimeToMicrosecs :: UrbitTime -> Int +urbitTimeToMicrosecs x = fromIntegral x + +-- TODO Double Check this +diffTime :: UrbitTime -> UrbitTime -> UrbitTime +diffTime fst snd | fst >= snd = 0 + | otherwise = snd - fst + +-- Behn Stuff ------------------------------------------------------------------ + +data Behn = Behn + { bState :: MVar (Maybe (UrbitTime, Async ())) + , bSignal :: MVar UrbitTime + } + +init :: IO Behn +init = do + st <- newMVar Nothing + sig <- newEmptyMVar + pure (Behn st sig) + +wait :: Behn -> IO UrbitTime +wait (Behn _ sig) = takeMVar sig + +startTimerThread :: Behn -> UrbitTime -> IO (Async ()) +startTimerThread (Behn vSt sig) time = + async $ do + now <- urNow + threadDelay (urbitTimeToMicrosecs (now `diffTime` time)) + void (swapMVar vSt Nothing >> tryPutMVar sig time) + +doze :: Behn -> Maybe UrbitTime -> IO () +doze behn@(Behn vSt sig) mNewTime = do + takeMVar vSt >>= \case Nothing -> pure () + Just (_,timer) -> cancel timer + + newSt <- mNewTime & \case + Nothing -> pure (Nothing :: Maybe (UrbitTime, Async ())) + Just time -> do timer <- startTimerThread behn time + pure (Just (time, timer)) + + void (putMVar vSt newSt) diff --git a/pkg/hs/vere/notes/BehnSketch.hs.txt b/pkg/hs/vere/notes/BehnSketch.hs.txt new file mode 100644 index 000000000..1fb89ccfc --- /dev/null +++ b/pkg/hs/vere/notes/BehnSketch.hs.txt @@ -0,0 +1,184 @@ +{- + TODO When is `u3_behn_io_init` called? +-} + +data Pier +data Timer + +data Wen = Wen Noun Noun Noun + +data TimeVal = TimeVal + { tv_sec :: time_t -- seconds + , tv_usec :: suseconds_t -- microseconds + } + +data Event + = Wake + | Born + +data Wire + = Blip -- Empty path + | Behn + | Sen Text -- "an instance string" + +newtype Knot = Knot Text + +newtype Wire = Wire [Knot] + +data Duct = [Wire] + +data Blip = Blip Behn (Maybe Void) + + +{- + alm -- is timer active? + tim -- timer + data -- associated pier +-} +data Behn = Behn + { _alm :: TVar Bool + , _tim :: TVar Timer + , _data :: TVar Pier + } + +makeLenses ''Behn + +-------------------------------------------------------------------------------- + +newTimer :: IO Timer +newTimer = undefined + +init :: Pier -> IO () +init p = + timer <- newTimer + atomically $ do + writeTVar (p ^. teh.alm) False + writeTVar (p ^. teh.tim) timer + writeTVar (p ^. teh.data) p + +exit :: Pier -> IO () +exit _ = pure () + +doze :: Pier -> Maybe Wen -> IO () +doze pir mWen = do + (active, timer) <- do + (,) <$> readTVarIO (pir ^. teh.alm) + <*> readTVarIO (pir ^. teh.tim) + + if active + then stopTimer timer -- TODO Race condition + else pure () + + case mWen of + Nothing -> pure () + Just (Wen x y z) -> do + timeVal <- getTimeOfDay + let now = u3_time_in_tv timeVal + let gap = u3_time_gap_ms(y, z) + writeTVar (p ^. teh.alm) True + startTimer timer gap $ do + u3_pier *pir_u = tim_u->data; + u3_behn* teh_u = pir_u->teh_u; + writeTVar (p ^. teh.alm) False; + pierWork pir [Blip Behn] Wake + +bake :: Pier -> IO () +bake = do + sen <- readTVarIO (u3A ^. sen) + pierWork pir [Blip Behn (Sen sen)] Born + +/* u3_behn_ef_bake(): notify %behn that we're live +*/ +void +u3_behn_ef_bake(u3_pier *pir_u) +{ + u3_noun pax = u3nq(u3_blip, c3__behn, u3k(u3A->sen), u3_nul); + + u3_pier_work(pir_u, pax, u3nc(c3__born, u3_nul)); +} + + +{- + u3_time_in_tv timeVal + u3_time_gap_ms(y, z) + u3nt(u3_blip, c3__behn, u3_nul), + u3nc(c3__wake, u3_nul)); +-} + + +-------------------------------------------------------------------------------- + +/* u3_behn(): initialize time timer. +*/ +void +u3_behn_io_init(u3_pier *pir_u) +{ + u3_behn* teh_u = pir_u->teh_u; + teh_u->alm = c3n; + + uv_timer_init(u3L, &teh_u->tim_u); + teh_u->tim_u.data = pir_u; +} + +/* u3_behn_io_exit(): terminate timer. +*/ +void +u3_behn_io_exit(u3_pier *pir_u) +{ +} + +/* _behn_time_cb(): timer callback. +*/ +static void +_behn_time_cb(uv_timer_t* tim_u) +{ + u3_pier *pir_u = tim_u->data; + u3_behn* teh_u = pir_u->teh_u; + teh_u->alm = c3n; + + { + u3_pier_work + (pir_u, + u3nt(u3_blip, c3__behn, u3_nul), + u3nc(c3__wake, u3_nul)); + } +} + +/* u3_behn_ef_doze(): set or cancel timer +*/ +void +u3_behn_ef_doze(u3_pier *pir_u, u3_noun wen) +{ + u3_behn* teh_u = pir_u->teh_u; + + if ( c3y == teh_u->alm ) { + uv_timer_stop(&teh_u->tim_u); + teh_u->alm = c3n; + } + + if ( (u3_nul != wen) && + (c3y == u3du(wen)) && + (c3y == u3ud(u3t(wen))) ) + { + struct timeval tim_tv; + gettimeofday(&tim_tv, 0); + + u3_noun now = u3_time_in_tv(&tim_tv); + c3_d gap_d = u3_time_gap_ms(now, u3k(u3t(wen))); + + teh_u->alm = c3y; + uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); + } + + u3z(wen); +} + +/* u3_behn_ef_bake(): notify %behn that we're live +*/ +void +u3_behn_ef_bake(u3_pier *pir_u) +{ + u3_noun pax = u3nq(u3_blip, c3__behn, u3k(u3A->sen), u3_nul); + + u3_pier_work(pir_u, pax, u3nc(c3__born, u3_nul)); +} diff --git a/pkg/hs/vere/Main.hs b/pkg/hs/vere/notes/Sketch.hs.txt similarity index 100% rename from pkg/hs/vere/Main.hs rename to pkg/hs/vere/notes/Sketch.hs.txt diff --git a/pkg/hs/vere/notes/c/ames.c b/pkg/hs/vere/notes/c/ames.c new file mode 100644 index 000000000..a7c2540be --- /dev/null +++ b/pkg/hs/vere/notes/c/ames.c @@ -0,0 +1,563 @@ +/* vere/ames.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _ames_alloc(): libuv buffer allocator. +*/ +static void +_ames_alloc(uv_handle_t* had_u, + size_t len_i, + uv_buf_t* buf + ) +{ + // we allocate 2K, which gives us plenty of space + // for a single ames packet (max size 1060 bytes) + // + void* ptr_v = c3_malloc(2048); + *buf = uv_buf_init(ptr_v, 2048); +} + +/* _ames_free(): contrasting free. +*/ +static void +_ames_free(void* ptr_v) +{ +// u3l_log("free %p\n", ptr_v); + free(ptr_v); +} + +/* _ames_pact_free(): free packet struct. +*/ +static void +_ames_pact_free(u3_pact* pac_u) +{ + free(pac_u->hun_y); + free(pac_u->dns_c); + free(pac_u); +} + +/* _ames_send_cb(): send callback. +*/ +static void +_ames_send_cb(uv_udp_send_t* req_u, c3_i sas_i) +{ + u3_pact* pac_u = (u3_pact*)req_u; + +#if 0 + if ( 0 != sas_i ) { + u3l_log("ames: send_cb: %s\n", uv_strerror(sas_i)); + } +#endif + + _ames_pact_free(pac_u); +} + +/* _ames_send(): send buffer to address on port. +*/ +static void +_ames_send(u3_pact* pac_u) +{ + // XX revisit + u3_pier* pir_u = u3_pier_stub(); + u3_ames* sam_u = pir_u->sam_u; + + if ( !pac_u->hun_y ) { + _ames_pact_free(pac_u); + return; + } + + struct sockaddr_in add_u; + + memset(&add_u, 0, sizeof(add_u)); + add_u.sin_family = AF_INET; + add_u.sin_addr.s_addr = htonl(pac_u->pip_w); + add_u.sin_port = htons(pac_u->por_s); + + uv_buf_t buf_u = uv_buf_init((c3_c*)pac_u->hun_y, pac_u->len_w); + + c3_i sas_i; + + if ( 0 != (sas_i = uv_udp_send(&pac_u->snd_u, + &sam_u->wax_u, + &buf_u, 1, + (const struct sockaddr*)&add_u, + _ames_send_cb)) ) { + u3l_log("ames: send: %s\n", uv_strerror(sas_i)); + } +} + +/* _ames_czar_port(): udp port for galaxy. +*/ +static c3_s +_ames_czar_port(c3_y imp_y) +{ + if ( c3n == u3_Host.ops_u.net ) { + return 31337 + imp_y; + } + else { + return 13337 + imp_y; + } +} + +/* _ames_czar_gone(): galaxy address resolution failed. +*/ +static void +_ames_czar_gone(u3_pact* pac_u, time_t now) +{ + // XX revisit + u3_pier* pir_u = u3_pier_stub(); + u3_ames* sam_u = pir_u->sam_u; + + u3l_log("ames: czar at %s: not found (b)\n", pac_u->dns_c); + if ( (0 == sam_u->imp_w[pac_u->imp_y]) || + (0xffffffff == sam_u->imp_w[pac_u->imp_y]) ) { + sam_u->imp_w[pac_u->imp_y] = 0xffffffff; + } /* else keep existing ip for 5 more minutes */ + sam_u->imp_t[pac_u->imp_y] = now; + + _ames_pact_free(pac_u); +} + +/* _ames_czar_cb(): galaxy address resolution callback. +*/ +static void +_ames_czar_cb(uv_getaddrinfo_t* adr_u, + c3_i sas_i, + struct addrinfo* aif_u) +{ + // XX revisit + u3_pier* pir_u = u3_pier_stub(); + u3_ames* sam_u = pir_u->sam_u; + + u3_pact* pac_u = (u3_pact*)adr_u->data; + time_t now = time(0); + + struct addrinfo* rai_u = aif_u; + + while ( 1 ) { + if ( !rai_u ) { + _ames_czar_gone(pac_u, now); + break; + } + + if ( (AF_INET == rai_u->ai_family) ) { + struct sockaddr_in* add_u = (struct sockaddr_in *)rai_u->ai_addr; + c3_w old_w = sam_u->imp_w[pac_u->imp_y]; + + sam_u->imp_w[pac_u->imp_y] = ntohl(add_u->sin_addr.s_addr); + sam_u->imp_t[pac_u->imp_y] = now; + +#if 1 + if ( sam_u->imp_w[pac_u->imp_y] != old_w + && sam_u->imp_w[pac_u->imp_y] != 0xffffffff ) { + u3_noun wad = u3i_words(1, &sam_u->imp_w[pac_u->imp_y]); + u3_noun nam = u3dc("scot", c3__if, wad); + c3_c* nam_c = u3r_string(nam); + + u3l_log("ames: czar %s: ip %s\n", pac_u->dns_c, nam_c); + + free(nam_c); u3z(nam); + } +#endif + + _ames_send(pac_u); + break; + } + + rai_u = rai_u->ai_next; + } + + free(adr_u); + uv_freeaddrinfo(aif_u); +} + + +/* _ames_czar(): galaxy address resolution. +*/ +static void +_ames_czar(u3_pact* pac_u, c3_c* bos_c) +{ + // XX revisit + u3_pier* pir_u = u3_pier_stub(); + u3_ames* sam_u = pir_u->sam_u; + + pac_u->por_s = _ames_czar_port(pac_u->imp_y); + + if ( c3n == u3_Host.ops_u.net ) { + pac_u->pip_w = 0x7f000001; + _ames_send(pac_u); + return; + } + + // if we don't have a galaxy domain, no-op + // + if ( 0 == bos_c ) { + u3_noun nam = u3dc("scot", 'p', pac_u->imp_y); + c3_c* nam_c = u3r_string(nam); + u3l_log("ames: no galaxy domain for %s, no-op\r\n", nam_c); + + free(nam_c); + u3z(nam); + return; + } + + time_t now = time(0); + + // backoff + if ( (0xffffffff == sam_u->imp_w[pac_u->imp_y]) && + (now - sam_u->imp_t[pac_u->imp_y]) < 300 ) { + _ames_pact_free(pac_u); + return; + } + + if ( (0 == sam_u->imp_w[pac_u->imp_y]) || + (now - sam_u->imp_t[pac_u->imp_y]) > 300 ) { /* 5 minute TTL */ + u3_noun nam = u3dc("scot", 'p', pac_u->imp_y); + c3_c* nam_c = u3r_string(nam); + // XX remove extra byte for '~' + pac_u->dns_c = c3_malloc(1 + strlen(bos_c) + 1 + strlen(nam_c)); + + snprintf(pac_u->dns_c, 256, "%s.%s", nam_c + 1, bos_c); + // u3l_log("czar %s, dns %s\n", nam_c, pac_u->dns_c); + + free(nam_c); + u3z(nam); + + { + uv_getaddrinfo_t* adr_u = c3_malloc(sizeof(*adr_u)); + adr_u->data = pac_u; + + c3_i sas_i; + + if ( 0 != (sas_i = uv_getaddrinfo(u3L, adr_u, + _ames_czar_cb, + pac_u->dns_c, 0, 0)) ) { + u3l_log("ames: %s\n", uv_strerror(sas_i)); + _ames_czar_gone(pac_u, now); + return; + } + } + } + else { + pac_u->pip_w = sam_u->imp_w[pac_u->imp_y]; + _ames_send(pac_u); + return; + } +} + +/* _ames_lane_ipv4(): IPv4 address/ from lane. +*/ +u3_noun +_ames_lane_ip(u3_noun lan, c3_s* por_s, c3_w* pip_w) +{ + switch ( u3h(lan) ) { + case c3__if: { + *por_s= (c3_s) u3h(u3t(u3t(lan))); + *pip_w = u3r_word(0, u3t(u3t(u3t(lan)))); + + return c3y; + } break; + case c3__is: { + u3_noun pq_lan = u3h(u3t(u3t(lan))); + + if ( u3_nul == pq_lan ) return c3n; + else return _ames_lane_ip(u3t(pq_lan), por_s, pip_w); + } break; + case c3__ix: { + *por_s = (c3_s) u3h(u3t(u3t(lan))); + *pip_w = u3r_word(0, u3t(u3t(u3t(lan)))); + + return c3y; + } break; + } + return c3n; +} + +/* u3_ames_ef_bake(): notify %ames that we're live. +*/ +void +u3_ames_ef_bake(u3_pier* pir_u) +{ + u3_noun pax = u3nq(u3_blip, c3__newt, u3k(u3A->sen), u3_nul); + + u3_pier_plan(pax, u3nc(c3__barn, u3_nul)); +} + +/* u3_ames_ef_send(): send packet to network (v4). +*/ +void +u3_ames_ef_send(u3_pier* pir_u, u3_noun lan, u3_noun pac) +{ + u3_ames* sam_u = pir_u->sam_u; + + if ( u3_Host.ops_u.fuz_w && ((rand() % 100) < u3_Host.ops_u.fuz_w) ) { + u3z(lan); u3z(pac); + return; + } + + u3_pact* pac_u = c3_calloc(sizeof(*pac_u)); + + if ( c3y == _ames_lane_ip(lan, &pac_u->por_s, &pac_u->pip_w) ) { + pac_u->len_w = u3r_met(3, pac); + pac_u->hun_y = c3_malloc(pac_u->len_w); + + u3r_bytes(0, pac_u->len_w, pac_u->hun_y, pac); + + if ( 0 == pac_u->pip_w ) { + pac_u->pip_w = 0x7f000001; + pac_u->por_s = pir_u->por_s; + } + + if ( (0 == (pac_u->pip_w >> 16)) && (1 == (pac_u->pip_w >> 8)) ) { + pac_u->imp_y = (pac_u->pip_w & 0xff); + + _ames_czar(pac_u, sam_u->dns_c); + } + else if ( (c3y == u3_Host.ops_u.net) || (0x7f000001 == pac_u->pip_w) ) { + _ames_send(pac_u); + } + else { + // networking disabled + _ames_pact_free(pac_u); + } + } + else { + _ames_pact_free(pac_u); + } + + u3z(lan); u3z(pac); +} + +/* _ames_recv_cb(): receive callback. +*/ +static void +_ames_recv_cb(uv_udp_t* wax_u, + ssize_t nrd_i, + const uv_buf_t * buf_u, + const struct sockaddr* adr_u, + unsigned flg_i) +{ + // u3l_log("ames: rx %p\r\n", buf_u.base); + + if ( 0 == nrd_i ) { + _ames_free(buf_u->base); + } + else { + { + u3_noun msg = u3i_bytes((c3_w)nrd_i, (c3_y*)buf_u->base); + + // u3l_log("ames: plan\r\n"); +#if 0 + u3z(msg); +#else + struct sockaddr_in* add_u = (struct sockaddr_in *)adr_u; + c3_s por_s = ntohs(add_u->sin_port); + c3_w pip_w = ntohl(add_u->sin_addr.s_addr); + + u3_pier_plan + (u3nt(u3_blip, c3__ames, u3_nul), + u3nt(c3__hear, + u3nq(c3__if, u3k(u3A->now), por_s, u3i_words(1, &pip_w)), + msg)); +#endif + } + _ames_free(buf_u->base); + } +} + +/* _ames_io_start(): initialize ames I/O. +*/ +static void +_ames_io_start(u3_pier* pir_u) +{ + u3_ames* sam_u = pir_u->sam_u; + c3_s por_s = pir_u->por_s; + u3_noun who = u3i_chubs(2, pir_u->who_d); + u3_noun rac = u3do("clan:title", u3k(who)); + + if ( c3__czar == rac ) { + u3_noun imp = u3dc("scot", 'p', u3k(who)); + c3_c* imp_c = u3r_string(imp); + c3_y num_y = (c3_y)pir_u->who_d[0]; + + por_s = _ames_czar_port(num_y); + + if ( c3y == u3_Host.ops_u.net ) { + u3l_log("ames: czar: %s on %d\n", imp_c, por_s); + } + else { + u3l_log("ames: czar: %s on %d (localhost only)\n", imp_c, por_s); + } + + u3z(imp); + free(imp_c); + } + + int ret; + if ( 0 != (ret = uv_udp_init(u3L, &sam_u->wax_u)) ) { + u3l_log("ames: init: %s\n", uv_strerror(ret)); + c3_assert(0); + } + + // Bind and stuff. + { + struct sockaddr_in add_u; + c3_i add_i = sizeof(add_u); + + memset(&add_u, 0, sizeof(add_u)); + add_u.sin_family = AF_INET; + add_u.sin_addr.s_addr = _(u3_Host.ops_u.net) ? + htonl(INADDR_ANY) : + htonl(INADDR_LOOPBACK); + add_u.sin_port = htons(por_s); + + int ret; + if ( (ret = uv_udp_bind(&sam_u->wax_u, + (const struct sockaddr*) & add_u, 0)) != 0 ) { + u3l_log("ames: bind: %s\n", + uv_strerror(ret)); + if (UV_EADDRINUSE == ret){ + u3l_log(" ...perhaps you've got two copies of vere running?\n"); + } + u3_pier_exit(pir_u); + } + + uv_udp_getsockname(&sam_u->wax_u, (struct sockaddr *)&add_u, &add_i); + c3_assert(add_u.sin_port); + + sam_u->por_s = ntohs(add_u.sin_port); + } + + // u3l_log("ames: on localhost, UDP %d.\n", sam_u->por_s); + uv_udp_recv_start(&sam_u->wax_u, _ames_alloc, _ames_recv_cb); + + sam_u->liv = c3y; + u3z(rac); + u3z(who); +} + +/* _cttp_mcut_char(): measure/cut character. +*/ +static c3_w +_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) +{ + if ( buf_c ) { + buf_c[len_w] = chr_c; + } + return len_w + 1; +} + +/* _cttp_mcut_cord(): measure/cut cord. +*/ +static c3_w +_cttp_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) +{ + c3_w ten_w = u3r_met(3, san); + + if ( buf_c ) { + u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); + } + u3z(san); + return (len_w + ten_w); +} + +/* _cttp_mcut_path(): measure/cut cord list. +*/ +static c3_w +_cttp_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) +{ + u3_noun axp = pax; + + while ( u3_nul != axp ) { + u3_noun h_axp = u3h(axp); + + len_w = _cttp_mcut_cord(buf_c, len_w, u3k(h_axp)); + axp = u3t(axp); + + if ( u3_nul != axp ) { + len_w = _cttp_mcut_char(buf_c, len_w, sep_c); + } + } + u3z(pax); + return len_w; +} + +/* _cttp_mcut_host(): measure/cut host. +*/ +static c3_w +_cttp_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot) +{ + len_w = _cttp_mcut_path(buf_c, len_w, '.', u3kb_flop(u3k(hot))); + u3z(hot); + return len_w; +} + +/* u3_ames_ef_turf(): initialize ames I/O on domain(s). +*/ +void +u3_ames_ef_turf(u3_pier* pir_u, u3_noun tuf) +{ + u3_ames* sam_u = pir_u->sam_u; + + if ( u3_nul != tuf ) { + // XX save all for fallback, not just first + u3_noun hot = u3k(u3h(tuf)); + c3_w len_w = _cttp_mcut_host(0, 0, u3k(hot)); + + sam_u->dns_c = c3_malloc(1 + len_w); + _cttp_mcut_host(sam_u->dns_c, 0, hot); + sam_u->dns_c[len_w] = 0; + + u3z(tuf); + } + else if ( (c3n == pir_u->fak_o) && (0 == sam_u->dns_c) ) { + u3l_log("ames: turf: no domains\n"); + } + + if ( c3n == sam_u->liv ) { + _ames_io_start(pir_u); + } +} + +/* u3_ames_io_init(): initialize ames I/O. +*/ +void +u3_ames_io_init(u3_pier* pir_u) +{ + u3_ames* sam_u = pir_u->sam_u; + sam_u->liv = c3n; +} + +/* u3_ames_io_talk(): start receiving ames traffic. +*/ +void +u3_ames_io_talk(u3_pier* pir_u) +{ +} + +/* u3_ames_io_exit(): terminate ames I/O. +*/ +void +u3_ames_io_exit(u3_pier* pir_u) +{ + u3_ames* sam_u = pir_u->sam_u; + + if ( c3y == sam_u->liv ) { + // XX remove had_u/wax_u union, cast and close wax_u + uv_close(&sam_u->had_u, 0); + } +} diff --git a/pkg/hs/vere/notes/c/behn.c b/pkg/hs/vere/notes/c/behn.c new file mode 100644 index 000000000..6da833eab --- /dev/null +++ b/pkg/hs/vere/notes/c/behn.c @@ -0,0 +1,90 @@ +/* vere/behn.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* u3_behn(): initialize time timer. +*/ +void +u3_behn_io_init(u3_pier *pir_u) +{ + u3_behn* teh_u = pir_u->teh_u; + teh_u->alm = c3n; + + uv_timer_init(u3L, &teh_u->tim_u); + teh_u->tim_u.data = pir_u; +} + +/* u3_behn_io_exit(): terminate timer. +*/ +void +u3_behn_io_exit(u3_pier *pir_u) +{ +} + +/* _behn_time_cb(): timer callback. +*/ +static void +_behn_time_cb(uv_timer_t* tim_u) +{ + u3_pier *pir_u = tim_u->data; + u3_behn* teh_u = pir_u->teh_u; + teh_u->alm = c3n; + + { + u3_pier_work + (pir_u, + u3nt(u3_blip, c3__behn, u3_nul), + u3nc(c3__wake, u3_nul)); + } +} + +/* u3_behn_ef_doze(): set or cancel timer +*/ +void +u3_behn_ef_doze(u3_pier *pir_u, u3_noun wen) +{ + u3_behn* teh_u = pir_u->teh_u; + + if ( c3y == teh_u->alm ) { + uv_timer_stop(&teh_u->tim_u); + teh_u->alm = c3n; + } + + if ( (u3_nul != wen) && + (c3y == u3du(wen)) && + (c3y == u3ud(u3t(wen))) ) + { + struct timeval tim_tv; + gettimeofday(&tim_tv, 0); + + u3_noun now = u3_time_in_tv(&tim_tv); + c3_d gap_d = u3_time_gap_ms(now, u3k(u3t(wen))); + + teh_u->alm = c3y; + uv_timer_start(&teh_u->tim_u, _behn_time_cb, gap_d, 0); + } + + u3z(wen); +} + +/* u3_behn_ef_bake(): notify %behn that we're live +*/ +void +u3_behn_ef_bake(u3_pier *pir_u) +{ + u3_noun pax = u3nq(u3_blip, c3__behn, u3k(u3A->sen), u3_nul); + + u3_pier_work(pir_u, pax, u3nc(c3__born, u3_nul)); +} diff --git a/pkg/hs/vere/notes/c/cttp.c b/pkg/hs/vere/notes/c/cttp.c new file mode 100644 index 000000000..36ff32440 --- /dev/null +++ b/pkg/hs/vere/notes/c/cttp.c @@ -0,0 +1,989 @@ +/* vere/cttp.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + + +// XX deduplicate with _http_vec_to_atom +/* _cttp_vec_to_atom(): convert h2o_iovec_t to atom (cord) +*/ +static u3_noun +_cttp_vec_to_atom(h2o_iovec_t vec_u) +{ + return u3i_bytes(vec_u.len, (const c3_y*)vec_u.base); +} + +/* _cttp_bods_free(): free body structure. +*/ +static void +_cttp_bods_free(u3_hbod* bod_u) +{ + while ( bod_u ) { + u3_hbod* nex_u = bod_u->nex_u; + + free(bod_u); + bod_u = nex_u; + } +} + +/* _cttp_bod_new(): create a data buffer +*/ +static u3_hbod* +_cttp_bod_new(c3_w len_w, c3_c* hun_c) +{ + u3_hbod* bod_u = c3_malloc(1 + len_w + sizeof(*bod_u)); + bod_u->hun_y[len_w] = 0; + bod_u->len_w = len_w; + memcpy(bod_u->hun_y, (const c3_y*)hun_c, len_w); + + bod_u->nex_u = 0; + return bod_u; +} + +/* _cttp_bod_from_hed(): create a data buffer from a header +*/ +static u3_hbod* +_cttp_bod_from_hed(u3_hhed* hed_u) +{ + c3_w len_w = hed_u->nam_w + 2 + hed_u->val_w + 2; + u3_hbod* bod_u = c3_malloc(1 + len_w + sizeof(*bod_u)); + bod_u->hun_y[len_w] = 0; + + memcpy(bod_u->hun_y, hed_u->nam_c, hed_u->nam_w); + memcpy(bod_u->hun_y + hed_u->nam_w, ": ", 2); + memcpy(bod_u->hun_y + hed_u->nam_w + 2, hed_u->val_c, hed_u->val_w); + memcpy(bod_u->hun_y + hed_u->nam_w + 2 + hed_u->val_w, "\r\n", 2); + + bod_u->len_w = len_w; + bod_u->nex_u = 0; + + return bod_u; +} + +/* _cttp_bods_to_octs: translate body buffer into octet-stream noun. +*/ +static u3_noun +_cttp_bods_to_octs(u3_hbod* bod_u) +{ + c3_w len_w; + c3_y* buf_y; + u3_noun cos; + + { + u3_hbod* bid_u = bod_u; + + len_w = 0; + while ( bid_u ) { + len_w += bid_u->len_w; + bid_u = bid_u->nex_u; + } + } + buf_y = c3_malloc(1 + len_w); + buf_y[len_w] = 0; + + { + c3_y* ptr_y = buf_y; + + while ( bod_u ) { + memcpy(ptr_y, bod_u->hun_y, bod_u->len_w); + ptr_y += bod_u->len_w; + bod_u = bod_u->nex_u; + } + } + cos = u3i_bytes(len_w, buf_y); + free(buf_y); + return u3nc(len_w, cos); +} + +/* _cttp_bod_from_octs(): translate octet-stream noun into body. +*/ +static u3_hbod* +_cttp_bod_from_octs(u3_noun oct) +{ + c3_w len_w; + + if ( !_(u3a_is_cat(u3h(oct))) ) { // 2GB max + u3m_bail(c3__fail); return 0; + } + len_w = u3h(oct); + + { + u3_hbod* bod_u = c3_malloc(1 + len_w + sizeof(*bod_u)); + bod_u->hun_y[len_w] = 0; + bod_u->len_w = len_w; + u3r_bytes(0, len_w, bod_u->hun_y, u3t(oct)); + + bod_u->nex_u = 0; + + u3z(oct); + return bod_u; + } +} + +/* _cttp_bods_to_vec(): translate body buffers to array of h2o_iovec_t +*/ +static h2o_iovec_t* +_cttp_bods_to_vec(u3_hbod* bod_u, c3_w* tot_w) +{ + h2o_iovec_t* vec_u; + c3_w len_w; + + { + u3_hbod* bid_u = bod_u; + len_w = 0; + + while( bid_u ) { + len_w++; + bid_u = bid_u->nex_u; + } + } + + if ( 0 == len_w ) { + *tot_w = len_w; + return 0; + } + + vec_u = c3_malloc(sizeof(h2o_iovec_t) * len_w); + len_w = 0; + + while( bod_u ) { + vec_u[len_w] = h2o_iovec_init(bod_u->hun_y, bod_u->len_w); + len_w++; + bod_u = bod_u->nex_u; + } + + *tot_w = len_w; + + return vec_u; +} + +// XX deduplicate with _http_heds_free +/* _cttp_heds_free(): free header linked list +*/ +static void +_cttp_heds_free(u3_hhed* hed_u) +{ + while ( hed_u ) { + u3_hhed* nex_u = hed_u->nex_u; + + free(hed_u->nam_c); + free(hed_u->val_c); + free(hed_u); + hed_u = nex_u; + } +} + +// XX deduplicate with _http_hed_new +/* _cttp_hed_new(): create u3_hhed from nam/val cords +*/ +static u3_hhed* +_cttp_hed_new(u3_atom nam, u3_atom val) +{ + c3_w nam_w = u3r_met(3, nam); + c3_w val_w = u3r_met(3, val); + u3_hhed* hed_u = c3_malloc(sizeof(*hed_u)); + + hed_u->nam_c = c3_malloc(1 + nam_w); + hed_u->val_c = c3_malloc(1 + val_w); + hed_u->nam_c[nam_w] = 0; + hed_u->val_c[val_w] = 0; + hed_u->nex_u = 0; + hed_u->nam_w = nam_w; + hed_u->val_w = val_w; + + u3r_bytes(0, nam_w, (c3_y*)hed_u->nam_c, nam); + u3r_bytes(0, val_w, (c3_y*)hed_u->val_c, val); + + return hed_u; +} + +// XX vv similar to _http_heds_from_noun +/* _cttp_heds_math(): create headers from +math +*/ +static u3_hhed* +_cttp_heds_math(u3_noun mah) +{ + u3_noun hed = u3kdi_tap(mah); + u3_noun deh = hed; + + u3_hhed* hed_u = 0; + + while ( u3_nul != hed ) { + u3_noun nam = u3h(u3h(hed)); + u3_noun lit = u3t(u3h(hed)); + + while ( u3_nul != lit ) { + u3_hhed* nex_u = _cttp_hed_new(nam, u3h(lit)); + nex_u->nex_u = hed_u; + + hed_u = nex_u; + lit = u3t(lit); + } + + hed = u3t(hed); + } + + u3z(deh); + return hed_u; +} + +// XX deduplicate with _http_heds_to_noun +/* _cttp_heds_to_noun(): convert h2o_header_t to (list (pair @t @t)) +*/ +static u3_noun +_cttp_heds_to_noun(h2o_header_t* hed_u, c3_d hed_d) +{ + u3_noun hed = u3_nul; + c3_d dex_d = hed_d; + + h2o_header_t deh_u; + + while ( 0 < dex_d ) { + deh_u = hed_u[--dex_d]; + hed = u3nc(u3nc(_cttp_vec_to_atom(*deh_u.name), + _cttp_vec_to_atom(deh_u.value)), hed); + } + + return hed; +} + +/* _cttp_cres_free(): free a u3_cres. +*/ +static void +_cttp_cres_free(u3_cres* res_u) +{ + _cttp_bods_free(res_u->bod_u); + free(res_u); +} + +/* _cttp_cres_new(): create a response +*/ +static void +_cttp_cres_new(u3_creq* ceq_u, c3_w sas_w) +{ + ceq_u->res_u = c3_calloc(sizeof(*ceq_u->res_u)); + ceq_u->res_u->sas_w = sas_w; +} + +/* _cttp_cres_fire_body(): attach response body buffer +*/ +static void +_cttp_cres_fire_body(u3_cres* res_u, u3_hbod* bod_u) +{ + c3_assert(!bod_u->nex_u); + + if ( !(res_u->bod_u) ) { + res_u->bod_u = res_u->dob_u = bod_u; + } + else { + res_u->dob_u->nex_u = bod_u; + res_u->dob_u = bod_u; + } +} + +/* _cttp_mcut_char(): measure/cut character. +*/ +static c3_w +_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) +{ + if ( buf_c ) { + buf_c[len_w] = chr_c; + } + return len_w + 1; +} + +/* _cttp_mcut_cord(): measure/cut cord. +*/ +static c3_w +_cttp_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) +{ + c3_w ten_w = u3r_met(3, san); + + if ( buf_c ) { + u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); + } + u3z(san); + return (len_w + ten_w); +} + +/* _cttp_mcut_path(): measure/cut cord list. +*/ +static c3_w +_cttp_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) +{ + u3_noun axp = pax; + + while ( u3_nul != axp ) { + u3_noun h_axp = u3h(axp); + + len_w = _cttp_mcut_cord(buf_c, len_w, u3k(h_axp)); + axp = u3t(axp); + + if ( u3_nul != axp ) { + len_w = _cttp_mcut_char(buf_c, len_w, sep_c); + } + } + u3z(pax); + return len_w; +} + +/* _cttp_mcut_host(): measure/cut host. +*/ +static c3_w +_cttp_mcut_host(c3_c* buf_c, c3_w len_w, u3_noun hot) +{ + len_w = _cttp_mcut_path(buf_c, len_w, '.', u3kb_flop(u3k(hot))); + u3z(hot); + return len_w; +} + +/* _cttp_mcut_pork(): measure/cut path/extension. +*/ +static c3_w +_cttp_mcut_pork(c3_c* buf_c, c3_w len_w, u3_noun pok) +{ + u3_noun h_pok = u3h(pok); + u3_noun t_pok = u3t(pok); + + len_w = _cttp_mcut_path(buf_c, len_w, '/', u3k(t_pok)); + if ( u3_nul != h_pok ) { + len_w = _cttp_mcut_char(buf_c, len_w, '.'); + len_w = _cttp_mcut_cord(buf_c, len_w, u3k(u3t(h_pok))); + } + u3z(pok); + return len_w; +} + +/* _cttp_mcut_quay(): measure/cut query. +*/ +static c3_w +_cttp_mcut_quay(c3_c* buf_c, c3_w len_w, u3_noun quy) +{ + if ( u3_nul == quy ) { + return len_w; + } + else { + u3_noun i_quy = u3h(quy); + u3_noun pi_quy = u3h(i_quy); + u3_noun qi_quy = u3t(i_quy); + u3_noun t_quy = u3t(quy); + + len_w = _cttp_mcut_char(buf_c, len_w, '&'); + len_w = _cttp_mcut_cord(buf_c, len_w, u3k(pi_quy)); + len_w = _cttp_mcut_char(buf_c, len_w, '='); + len_w = _cttp_mcut_cord(buf_c, len_w, u3k(qi_quy)); + + len_w = _cttp_mcut_quay(buf_c, len_w, u3k(t_quy)); + } + u3z(quy); + return len_w; +} + +/* _cttp_mcut_url(): measure/cut purl, producing relative URL. +*/ +static c3_w +_cttp_mcut_url(c3_c* buf_c, c3_w len_w, u3_noun pul) +{ + u3_noun q_pul = u3h(u3t(pul)); + u3_noun r_pul = u3t(u3t(pul)); + + len_w = _cttp_mcut_char(buf_c, len_w, '/'); + len_w = _cttp_mcut_pork(buf_c, len_w, u3k(q_pul)); + + if ( u3_nul != r_pul ) { + len_w = _cttp_mcut_char(buf_c, len_w, '?'); + len_w = _cttp_mcut_quay(buf_c, len_w, u3k(r_pul)); + } + u3z(pul); + return len_w; +} + +/* _cttp_creq_port(): stringify port +*/ +static c3_c* +_cttp_creq_port(c3_s por_s) +{ + c3_c* por_c = c3_malloc(8); + snprintf(por_c, 7, "%d", 0xffff & por_s); + return por_c; +} + +/* _cttp_creq_url(): construct url from noun. +*/ +static c3_c* +_cttp_creq_url(u3_noun pul) +{ + c3_w len_w = _cttp_mcut_url(0, 0, u3k(pul)); + c3_c* url_c = c3_malloc(1 + len_w); + + _cttp_mcut_url(url_c, 0, pul); + url_c[len_w] = 0; + + return url_c; +} + +/* _cttp_creq_host(): construct host from noun. +*/ +static c3_c* +_cttp_creq_host(u3_noun hot) +{ + c3_w len_w = _cttp_mcut_host(0, 0, u3k(hot)); + c3_c* hot_c = c3_malloc(1 + len_w); + + _cttp_mcut_host(hot_c, 0, hot); + hot_c[len_w] = 0; + + return hot_c; +} + +/* _cttp_creq_ip(): stringify ip +*/ +static c3_c* +_cttp_creq_ip(c3_w ipf_w) +{ + c3_c* ipf_c = c3_malloc(17); + snprintf(ipf_c, 16, "%d.%d.%d.%d", (ipf_w >> 24), + ((ipf_w >> 16) & 255), + ((ipf_w >> 8) & 255), + (ipf_w & 255)); + return ipf_c; +} + +/* _cttp_creq_find(): find a request by number in the client +*/ +static u3_creq* +_cttp_creq_find(c3_l num_l) +{ + u3_creq* ceq_u = u3_Host.ctp_u.ceq_u; + + // XX glories of linear search + // + while ( ceq_u ) { + if ( num_l == ceq_u->num_l ) { + return ceq_u; + } + ceq_u = ceq_u->nex_u; + } + return 0; +} + +/* _cttp_creq_link(): link request to client +*/ +static void +_cttp_creq_link(u3_creq* ceq_u) +{ + ceq_u->nex_u = u3_Host.ctp_u.ceq_u; + + if ( 0 != ceq_u->nex_u ) { + ceq_u->nex_u->pre_u = ceq_u; + } + u3_Host.ctp_u.ceq_u = ceq_u; +} + +/* _cttp_creq_unlink(): unlink request from client +*/ +static void +_cttp_creq_unlink(u3_creq* ceq_u) +{ + if ( ceq_u->pre_u ) { + ceq_u->pre_u->nex_u = ceq_u->nex_u; + + if ( 0 != ceq_u->nex_u ) { + ceq_u->nex_u->pre_u = ceq_u->pre_u; + } + } + else { + u3_Host.ctp_u.ceq_u = ceq_u->nex_u; + + if ( 0 != ceq_u->nex_u ) { + ceq_u->nex_u->pre_u = 0; + } + } +} + +/* _cttp_creq_free(): free a u3_creq. +*/ +static void +_cttp_creq_free(u3_creq* ceq_u) +{ + _cttp_creq_unlink(ceq_u); + + _cttp_heds_free(ceq_u->hed_u); + // Note: ceq_u->bod_u is covered here + _cttp_bods_free(ceq_u->rub_u); + + if ( ceq_u->res_u ) { + _cttp_cres_free(ceq_u->res_u); + } + + free(ceq_u->hot_c); + free(ceq_u->por_c); + free(ceq_u->url_c); + free(ceq_u->vec_u); + free(ceq_u); +} + +/* _cttp_creq_new(): create a request from a +hiss noun +*/ +static u3_creq* +_cttp_creq_new(c3_l num_l, u3_noun hes) +{ + u3_creq* ceq_u = c3_calloc(sizeof(*ceq_u)); + + u3_noun pul = u3h(hes); // +purl + u3_noun hat = u3h(pul); // +hart + u3_noun sec = u3h(hat); + u3_noun por = u3h(u3t(hat)); + u3_noun hot = u3t(u3t(hat)); // +host + u3_noun moh = u3t(hes); // +moth + u3_noun met = u3h(moh); // +meth + u3_noun mah = u3h(u3t(moh)); // +math + u3_noun bod = u3t(u3t(moh)); + + ceq_u->sat_e = u3_csat_init; + ceq_u->num_l = num_l; + ceq_u->sec = sec; + + if ( c3y == u3h(hot) ) { + ceq_u->hot_c = _cttp_creq_host(u3k(u3t(hot))); + } else { + ceq_u->ipf_w = u3r_word(0, u3t(hot)); + ceq_u->ipf_c = _cttp_creq_ip(ceq_u->ipf_w); + } + + if ( u3_nul != por ) { + ceq_u->por_s = u3t(por); + ceq_u->por_c = _cttp_creq_port(ceq_u->por_s); + } + + ceq_u->met_m = met; + ceq_u->url_c = _cttp_creq_url(u3k(pul)); + ceq_u->hed_u = _cttp_heds_math(u3k(mah)); + + if ( u3_nul != bod ) { + ceq_u->bod_u = _cttp_bod_from_octs(u3k(u3t(bod))); + } + + _cttp_creq_link(ceq_u); + + u3z(hes); + return ceq_u; +} + +/* _cttp_creq_fire_body(): attach body to request buffers. +*/ +static void +_cttp_creq_fire_body(u3_creq* ceq_u, u3_hbod *rub_u) +{ + c3_assert(!rub_u->nex_u); + + if ( !(ceq_u->rub_u) ) { + ceq_u->rub_u = ceq_u->bur_u = rub_u; + } + else { + ceq_u->bur_u->nex_u = rub_u; + ceq_u->bur_u = rub_u; + } +} + +/* _cttp_creq_fire_str(): attach string to request buffers. +*/ +static void +_cttp_creq_fire_str(u3_creq* ceq_u, c3_c* str_c) +{ + _cttp_creq_fire_body(ceq_u, _cttp_bod_new(strlen(str_c), str_c)); +} + +/* _cttp_creq_fire_heds(): attach output headers. +*/ +static void +_cttp_creq_fire_heds(u3_creq* ceq_u, u3_hhed* hed_u) +{ + while ( hed_u ) { + _cttp_creq_fire_body(ceq_u, _cttp_bod_from_hed(hed_u)); + hed_u = hed_u->nex_u; + } +} + +/* _cttp_creq_fire(): load request data for into buffers. +*/ +static void +_cttp_creq_fire(u3_creq* ceq_u) +{ + switch ( ceq_u->met_m ) { + default: c3_assert(0); + case c3__get: _cttp_creq_fire_str(ceq_u, "GET "); break; + case c3__put: _cttp_creq_fire_str(ceq_u, "PUT "); break; + case c3__post: _cttp_creq_fire_str(ceq_u, "POST "); break; + case c3__head: _cttp_creq_fire_str(ceq_u, "HEAD "); break; + case c3__conn: _cttp_creq_fire_str(ceq_u, "CONNECT "); break; + case c3__delt: _cttp_creq_fire_str(ceq_u, "DELETE "); break; + case c3__opts: _cttp_creq_fire_str(ceq_u, "OPTIONS "); break; + case c3__trac: _cttp_creq_fire_str(ceq_u, "TRACE "); break; + } + _cttp_creq_fire_str(ceq_u, ceq_u->url_c); + _cttp_creq_fire_str(ceq_u, " HTTP/1.1\r\n"); + + { + c3_c* hot_c = ceq_u->hot_c ? ceq_u->hot_c : ceq_u->ipf_c; + c3_c* hos_c; + c3_w len_w; + + if ( ceq_u->por_c ) { + len_w = 6 + strlen(hot_c) + 1 + strlen(ceq_u->por_c) + 3; + hos_c = c3_malloc(len_w); + len_w = snprintf(hos_c, len_w, "Host: %s:%s\r\n", hot_c, ceq_u->por_c); + } + else { + len_w = 6 + strlen(hot_c) + 3; + hos_c = c3_malloc(len_w); + len_w = snprintf(hos_c, len_w, "Host: %s\r\n", hot_c); + } + + _cttp_creq_fire_body(ceq_u, _cttp_bod_new(len_w, hos_c)); + free(hos_c); + } + + _cttp_creq_fire_heds(ceq_u, ceq_u->hed_u); + + if ( !ceq_u->bod_u ) { + _cttp_creq_fire_body(ceq_u, _cttp_bod_new(2, "\r\n")); + } + else { + c3_c len_c[41]; + c3_w len_w = snprintf(len_c, 40, "Content-Length: %u\r\n\r\n", + ceq_u->bod_u->len_w); + + _cttp_creq_fire_body(ceq_u, _cttp_bod_new(len_w, len_c)); + _cttp_creq_fire_body(ceq_u, ceq_u->bod_u); + } +} + +/* _cttp_creq_quit(): cancel a u3_creq +*/ +static void +_cttp_creq_quit(u3_creq* ceq_u) +{ + if ( u3_csat_addr == ceq_u->sat_e ) { + ceq_u->sat_e = u3_csat_quit; + return; // wait to be called again on address resolution + } + + if ( ceq_u->cli_u ) { + h2o_http1client_cancel(ceq_u->cli_u); + } + + _cttp_creq_free(ceq_u); +} + +/* _cttp_httr(): dispatch http response to %eyre +*/ +static void +_cttp_httr(c3_l num_l, c3_w sas_w, u3_noun mes, u3_noun uct) +{ + u3_noun htr = u3nt(sas_w, mes, uct); + u3_noun pox = u3nt(u3_blip, c3__http, u3_nul); + + u3_pier_plan(pox, u3nt(c3__they, num_l, htr)); +} + +/* _cttp_creq_quit(): dispatch error response +*/ +static void +_cttp_creq_fail(u3_creq* ceq_u, const c3_c* err_c) +{ + // XX anything other than a 504? + c3_w cod_w = 504; + + u3l_log("http: fail (%d, %d): %s\r\n", ceq_u->num_l, cod_w, err_c); + + // XX include err_c as response body? + _cttp_httr(ceq_u->num_l, cod_w, u3_nul, u3_nul); + _cttp_creq_free(ceq_u); +} + +/* _cttp_creq_quit(): dispatch response +*/ +static void +_cttp_creq_respond(u3_creq* ceq_u) +{ + u3_cres* res_u = ceq_u->res_u; + + _cttp_httr(ceq_u->num_l, res_u->sas_w, res_u->hed, + ( !res_u->bod_u ) ? u3_nul : + u3nc(u3_nul, _cttp_bods_to_octs(res_u->bod_u))); + + _cttp_creq_free(ceq_u); +} + +// XX research: may be called with closed client? +/* _cttp_creq_on_body(): cb invoked by h2o upon receiving a response body +*/ +static c3_i +_cttp_creq_on_body(h2o_http1client_t* cli_u, const c3_c* err_c) +{ + u3_creq* ceq_u = (u3_creq *)cli_u->data; + + if ( 0 != err_c && h2o_http1client_error_is_eos != err_c ) { + _cttp_creq_fail(ceq_u, err_c); + return -1; + } + + h2o_buffer_t* buf_u = cli_u->sock->input; + + if ( buf_u->size ) { + _cttp_cres_fire_body(ceq_u->res_u, + _cttp_bod_new(buf_u->size, buf_u->bytes)); + h2o_buffer_consume(&cli_u->sock->input, buf_u->size); + } + + if ( h2o_http1client_error_is_eos == err_c ) { + _cttp_creq_respond(ceq_u); + } + + return 0; +} + +/* _cttp_creq_on_head(): cb invoked by h2o upon receiving response headers +*/ +static h2o_http1client_body_cb +_cttp_creq_on_head(h2o_http1client_t* cli_u, const c3_c* err_c, c3_i ver_i, + c3_i sas_i, h2o_iovec_t sas_u, h2o_header_t* hed_u, + size_t hed_t, c3_i len_i) +{ + u3_creq* ceq_u = (u3_creq *)cli_u->data; + + if ( 0 != err_c && h2o_http1client_error_is_eos != err_c ) { + _cttp_creq_fail(ceq_u, err_c); + return 0; + } + + _cttp_cres_new(ceq_u, (c3_w)sas_i); + ceq_u->res_u->hed = _cttp_heds_to_noun(hed_u, hed_t); + + if ( h2o_http1client_error_is_eos == err_c ) { + _cttp_creq_respond(ceq_u); + return 0; + } + + return _cttp_creq_on_body; +} + +/* _cttp_creq_on_connect(): cb invoked by h2o upon successful connection +*/ +static h2o_http1client_head_cb +_cttp_creq_on_connect(h2o_http1client_t* cli_u, const c3_c* err_c, + h2o_iovec_t** vec_p, size_t* vec_t, c3_i* hed_i) +{ + u3_creq* ceq_u = (u3_creq *)cli_u->data; + + if ( 0 != err_c ) { + _cttp_creq_fail(ceq_u, err_c); + return 0; + } + + { + c3_w len_w; + ceq_u->vec_u = _cttp_bods_to_vec(ceq_u->rub_u, &len_w); + *vec_t = len_w; + *vec_p = ceq_u->vec_u; + *hed_i = c3__head == ceq_u->met_m; + } + + return _cttp_creq_on_head; +} + +/* _cttp_creq_connect(): establish connection +*/ +static void +_cttp_creq_connect(u3_creq* ceq_u) +{ + c3_assert(u3_csat_ripe == ceq_u->sat_e); + c3_assert(ceq_u->ipf_c); + + h2o_iovec_t ipf_u = h2o_iovec_init(ceq_u->ipf_c, strlen(ceq_u->ipf_c)); + c3_s por_s = ceq_u->por_s ? ceq_u->por_s : + ( c3y == ceq_u->sec ) ? 443 : 80; + + // connect by IP + h2o_http1client_connect(&ceq_u->cli_u, ceq_u, u3_Host.ctp_u.ctx_u, ipf_u, + por_s, c3y == ceq_u->sec, _cttp_creq_on_connect); + + // set hostname for TLS handshake + if ( ceq_u->hot_c && c3y == ceq_u->sec ) { + c3_w len_w = 1 + strlen(ceq_u->hot_c); + c3_c* hot_c = c3_malloc(len_w); + strncpy(hot_c, ceq_u->hot_c, len_w); + + free(ceq_u->cli_u->ssl.server_name); + ceq_u->cli_u->ssl.server_name = hot_c; + } + + _cttp_creq_fire(ceq_u); +} + +/* _cttp_creq_resolve_cb(): cb upon IP address resolution +*/ +static void +_cttp_creq_resolve_cb(uv_getaddrinfo_t* adr_u, + c3_i sas_i, + struct addrinfo* aif_u) +{ + u3_creq* ceq_u = adr_u->data; + + if ( u3_csat_quit == ceq_u->sat_e ) { + _cttp_creq_quit(ceq_u);; + } + else if ( 0 != sas_i ) { + _cttp_creq_fail(ceq_u, uv_strerror(sas_i)); + } + else { + // XX traverse struct a la _ames_czar_cb + ceq_u->ipf_w = ntohl(((struct sockaddr_in *)aif_u->ai_addr)->sin_addr.s_addr); + ceq_u->ipf_c = _cttp_creq_ip(ceq_u->ipf_w); + + ceq_u->sat_e = u3_csat_ripe; + _cttp_creq_connect(ceq_u); + } + + free(adr_u); + uv_freeaddrinfo(aif_u); +} + +/* _cttp_creq_resolve(): resolve hostname to IP address +*/ +static void +_cttp_creq_resolve(u3_creq* ceq_u) +{ + c3_assert(u3_csat_addr == ceq_u->sat_e); + c3_assert(ceq_u->hot_c); + + uv_getaddrinfo_t* adr_u = c3_malloc(sizeof(*adr_u)); + adr_u->data = ceq_u; + + struct addrinfo hin_u; + memset(&hin_u, 0, sizeof(struct addrinfo)); + + hin_u.ai_family = PF_INET; + hin_u.ai_socktype = SOCK_STREAM; + hin_u.ai_protocol = IPPROTO_TCP; + + // XX is this necessary? + c3_c* por_c = ceq_u->por_c ? ceq_u->por_c : + ( c3y == ceq_u->sec ) ? "443" : "80"; + + c3_i sas_i; + + if ( 0 != (sas_i = uv_getaddrinfo(u3L, adr_u, _cttp_creq_resolve_cb, + ceq_u->hot_c, por_c, &hin_u)) ) { + _cttp_creq_fail(ceq_u, uv_strerror(sas_i)); + } +} + +/* _cttp_creq_start(): start a request +*/ +static void +_cttp_creq_start(u3_creq* ceq_u) +{ + if ( ceq_u->ipf_c ) { + ceq_u->sat_e = u3_csat_ripe; + _cttp_creq_connect(ceq_u); + } else { + ceq_u->sat_e = u3_csat_addr; + _cttp_creq_resolve(ceq_u); + } +} + +/* _cttp_init_tls: initialize OpenSSL context +*/ +static SSL_CTX* +_cttp_init_tls() +{ + // XX require 1.1.0 and use TLS_client_method() + SSL_CTX* tls_u = SSL_CTX_new(SSLv23_client_method()); + // XX use SSL_CTX_set_max_proto_version() and SSL_CTX_set_min_proto_version() + SSL_CTX_set_options(tls_u, SSL_OP_NO_SSLv2 | + SSL_OP_NO_SSLv3 | + // SSL_OP_NO_TLSv1 | // XX test + SSL_OP_NO_COMPRESSION); + + SSL_CTX_set_verify(tls_u, SSL_VERIFY_PEER, 0); + SSL_CTX_set_default_verify_paths(tls_u); + SSL_CTX_set_session_cache_mode(tls_u, SSL_SESS_CACHE_OFF); + SSL_CTX_set_cipher_list(tls_u, + "ECDH+AESGCM:DH+AESGCM:ECDH+AES256:DH+AES256:" + "ECDH+AES128:DH+AES:ECDH+3DES:DH+3DES:RSA+AESGCM:" + "RSA+AES:RSA+3DES:!aNULL:!MD5:!DSS"); + + return tls_u; +} + +/* _cttp_init_h2o: initialize h2o client ctx and timeout +*/ +static h2o_http1client_ctx_t* +_cttp_init_h2o() +{ + h2o_timeout_t* tim_u = c3_malloc(sizeof(*tim_u)); + + h2o_timeout_init(u3L, tim_u, 300 * 1000); + + h2o_http1client_ctx_t* ctx_u = c3_calloc(sizeof(*ctx_u)); + ctx_u->loop = u3L; + ctx_u->io_timeout = tim_u; + + return ctx_u; +}; + +/* u3_cttp_ef_thus(): send %thus effect (outgoing request) to cttp. +*/ +void +u3_cttp_ef_thus(c3_l num_l, + u3_noun cuq) +{ + u3_creq* ceq_u; + + if ( u3_nul == cuq ) { + ceq_u =_cttp_creq_find(num_l); + + if ( ceq_u ) { + _cttp_creq_quit(ceq_u); + } + } + else { + ceq_u = _cttp_creq_new(num_l, u3k(u3t(cuq))); + _cttp_creq_start(ceq_u); + } + u3z(cuq); +} + +/* u3_cttp_io_init(): initialize http client I/O. +*/ +void +u3_cttp_io_init() +{ + u3_Host.ctp_u.tls_u = _cttp_init_tls(); + u3_Host.ctp_u.ctx_u = _cttp_init_h2o(); + u3_Host.ctp_u.ctx_u->ssl_ctx = u3_Host.ctp_u.tls_u; + u3_Host.ctp_u.ceq_u = 0; +} + +/* u3_cttp_io_exit(): shut down cttp. +*/ +void +u3_cttp_io_exit(void) +{ + SSL_CTX_free(u3_Host.ctp_u.tls_u); + free(u3_Host.ctp_u.ctx_u->io_timeout); + free(u3_Host.ctp_u.ctx_u); +} diff --git a/pkg/hs/vere/notes/c/daemon.c b/pkg/hs/vere/notes/c/daemon.c new file mode 100644 index 000000000..293f9c6c9 --- /dev/null +++ b/pkg/hs/vere/notes/c/daemon.c @@ -0,0 +1,735 @@ +/* vere/main.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define U3_GLOBAL +#define C3_GLOBAL +#include "all.h" +#include "vere/vere.h" + +/* Require unsigned char + */ +STATIC_ASSERT(( 0 == CHAR_MIN && UCHAR_MAX == CHAR_MAX ), + "unsigned char required"); + +/* _main_readw(): parse a word from a string. +*/ +static u3_noun +_main_readw(const c3_c* str_c, c3_w max_w, c3_w* out_w) +{ + c3_c* end_c; + c3_w par_w = strtoul(str_c, &end_c, 0); + + if ( *str_c != '\0' && *end_c == '\0' && par_w < max_w ) { + *out_w = par_w; + return c3y; + } + else return c3n; +} + +/* _main_presig(): prefix optional sig. +*/ +c3_c* +_main_presig(c3_c* txt_c) +{ + c3_c* new_c = malloc(2 + strlen(txt_c)); + + if ( '~' == *txt_c ) { + strcpy(new_c, txt_c); + } else { + new_c[0] = '~'; + strcpy(new_c + 1, txt_c); + } + return new_c; +} + +/* _main_getopt(): extract option map from command line. +*/ +static u3_noun +_main_getopt(c3_i argc, c3_c** argv) +{ + c3_i ch_i; + c3_w arg_w; + + u3_Host.ops_u.abo = c3n; + u3_Host.ops_u.bat = c3n; + u3_Host.ops_u.can = c3n; + u3_Host.ops_u.dem = c3n; + u3_Host.ops_u.dry = c3n; + u3_Host.ops_u.etn = c3n; + u3_Host.ops_u.gab = c3n; + u3_Host.ops_u.git = c3n; + + // always disable hashboard + // XX temporary, remove once hashes are added + // + u3_Host.ops_u.has = c3y; + + u3_Host.ops_u.net = c3y; + u3_Host.ops_u.nuu = c3n; + u3_Host.ops_u.pro = c3n; + u3_Host.ops_u.qui = c3n; + u3_Host.ops_u.rep = c3n; + u3_Host.ops_u.tex = c3n; + u3_Host.ops_u.tra = c3n; + u3_Host.ops_u.veb = c3n; + u3_Host.ops_u.kno_w = DefaultKernel; + + while ( -1 != (ch_i=getopt(argc, argv, + "G:J:B:K:A:H:w:u:e:E:f:F:k:m:p:LjabcCdgqstvxPDRS")) ) + { + switch ( ch_i ) { + case 'J': { + u3_Host.ops_u.lit_c = strdup(optarg); + break; + } + case 'B': { + u3_Host.ops_u.pil_c = strdup(optarg); + break; + } + case 'G': { + u3_Host.ops_u.gen_c = strdup(optarg); + break; + } + case 'A': { + u3_Host.ops_u.arv_c = strdup(optarg); + break; + } + case 'H': { + u3_Host.ops_u.dns_c = strdup(optarg); + break; + } + case 'e': { + u3_Host.ops_u.eth_c = strdup(optarg); + break; + } + case 'E': { + u3_Host.ops_u.ets_c = strdup(optarg); + break; + } + case 'F': { + u3_Host.ops_u.fak_c = _main_presig(optarg); + u3_Host.ops_u.net = c3n; + break; + } + case 'w': { + u3_Host.ops_u.who_c = _main_presig(optarg); + u3_Host.ops_u.nuu = c3y; + break; + } + case 'u': { + u3_Host.ops_u.url_c = strdup(optarg); + break; + } + case 'x': { + u3_Host.ops_u.tex = c3y; + break; + } + case 'f': { + if ( c3n == _main_readw(optarg, 100, &u3_Host.ops_u.fuz_w) ) { + return c3n; + } + break; + } + case 'K': { + if ( c3n == _main_readw(optarg, 256, &u3_Host.ops_u.kno_w) ) { + return c3n; + } + break; + } + case 'k': { + u3_Host.ops_u.key_c = strdup(optarg); + break; + } + case 'm': { + u3_Host.ops_u.sap_c = strdup(optarg); + break; + } + case 'p': { + if ( c3n == _main_readw(optarg, 65536, &arg_w) ) { + return c3n; + } else u3_Host.ops_u.por_s = arg_w; + break; + } + case 'R': { + u3_Host.ops_u.rep = c3y; + return c3y; + } + case 'L': { u3_Host.ops_u.net = c3n; break; } + case 'j': { u3_Host.ops_u.tra = c3y; break; } + case 'a': { u3_Host.ops_u.abo = c3y; break; } + case 'b': { u3_Host.ops_u.bat = c3y; break; } + case 'c': { u3_Host.ops_u.nuu = c3y; break; } + case 'C': { u3_Host.ops_u.can = c3y; break; } + case 'd': { u3_Host.ops_u.dem = c3y; break; } + case 'g': { u3_Host.ops_u.gab = c3y; break; } + case 'P': { u3_Host.ops_u.pro = c3y; break; } + case 'D': { u3_Host.ops_u.dry = c3y; break; } + case 'q': { u3_Host.ops_u.qui = c3y; break; } + case 'v': { u3_Host.ops_u.veb = c3y; break; } + case 's': { u3_Host.ops_u.git = c3y; break; } + case 'S': { u3_Host.ops_u.has = c3y; break; } + case 't': { u3_Host.ops_u.etn = c3y; break; } + case '?': default: { + return c3n; + } + } + } + +#if defined(U3_OS_bsd) + if (u3_Host.ops_u.pro == c3y) { + fprintf(stderr, "profiling isn't yet supported on BSD\r\n"); + return c3n; + } +#endif + + if ( 0 != u3_Host.ops_u.fak_c ) { + if ( 28 < strlen(u3_Host.ops_u.fak_c) ) { + fprintf(stderr, "fake comets are disallowed\r\n"); + return c3n; + } + + u3_Host.ops_u.who_c = strdup(u3_Host.ops_u.fak_c); + u3_Host.ops_u.has = c3y; /* no battery hashing on fake ships. */ + u3_Host.ops_u.net = c3n; /* no networking on fake ships. */ + u3_Host.ops_u.nuu = c3y; + } + + if ( argc != (optind + 1) && u3_Host.ops_u.who_c != 0 ) { + u3_Host.dir_c = strdup(1 + u3_Host.ops_u.who_c); + } + + if ( argc != (optind + 1) ) { + return u3_Host.dir_c ? c3y : c3n; + } else { + { + c3_c* ash_c; + + if ( (ash_c = strrchr(argv[optind], '/')) && (ash_c[1] == 0) ) { + *ash_c = 0; + } + } + + u3_Host.dir_c = strdup(argv[optind]); + } + + if ( c3y == u3_Host.ops_u.bat ) { + u3_Host.ops_u.dem = c3y; + u3_Host.ops_u.nuu = c3y; + } + + // make -c optional, catch invalid boot of existing pier + // + { + struct stat s; + if ( 0 != stat(u3_Host.dir_c, &s) ) { + if ( c3n == u3_Host.ops_u.nuu ) { + u3_Host.ops_u.nuu = c3y; + } + } + else if ( c3y == u3_Host.ops_u.nuu ) { + fprintf(stderr, "tried to create, but %s already exists\n", u3_Host.dir_c); + fprintf(stderr, "normal usage: %s %s\n", argv[0], u3_Host.dir_c); + exit(1); + } + } + + c3_t imp_t = ((0 != u3_Host.ops_u.who_c) && + (4 == strlen(u3_Host.ops_u.who_c))); + + if ( u3_Host.ops_u.gen_c != 0 && u3_Host.ops_u.nuu == c3n ) { + fprintf(stderr, "-G only makes sense when bootstrapping a new instance\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.who_c != 0) { + fprintf(stderr, "-w only makes sense when creating a new ship\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.pil_c != 0) { + fprintf(stderr, "-B only makes sense when creating a new ship\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.dns_c != 0) { + fprintf(stderr, "-H only makes sense when bootstrapping a new instance\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.pil_c != 0) { + fprintf(stderr, "-B only makes sense when bootstrapping a new instance\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.key_c != 0) { + fprintf(stderr, "-k only makes sense when bootstrapping a new instance\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.url_c != 0 ) { + fprintf(stderr, "-u only makes sense when bootstrapping a new instance\n"); + return c3n; + } + + if ( u3_Host.ops_u.nuu != c3y && u3_Host.ops_u.sap_c != 0 ) { + fprintf(stderr, "-m only makes sense when bootstrapping a new instance\n"); + return c3n; + } + + if ( u3_Host.ops_u.fak_c != 0 && u3_Host.ops_u.sap_c != 0 ) { + fprintf(stderr, "-m and -F cannot be used together\n"); + return c3n; + } + + if ( u3_Host.ops_u.ets_c != 0 && u3_Host.ops_u.sap_c != 0 ) { + fprintf(stderr, "-m and -E cannot be used together\n"); + return c3n; + } + if ( u3_Host.ops_u.can == c3y && u3_Host.ops_u.sap_c != 0 ) { + fprintf(stderr, "-m and -C cannot be used together\n"); + return c3n; + } + if ( u3_Host.ops_u.can == c3y && u3_Host.ops_u.ets_c != 0 ) { + fprintf(stderr, "-C and -E cannot be used together\n"); + return c3n; + } + + if ( u3_Host.ops_u.eth_c == 0 && imp_t ) { + u3_Host.ops_u.eth_c = "http://eth-mainnet.urbit.org:8545"; + } + + if ( u3_Host.ops_u.sap_c == 0 && u3_Host.ops_u.can == c3n ) { + + u3_Host.ops_u.sap_c = + "https://bootstrap.urbit.org/urbit-" URBIT_VERSION ".snap"; + } + + if ( u3_Host.ops_u.url_c != 0 && u3_Host.ops_u.pil_c != 0 ) { + fprintf(stderr, "-B and -u cannot be used together\n"); + return c3n; + } + else if ( u3_Host.ops_u.nuu == c3y + && u3_Host.ops_u.url_c == 0 + && u3_Host.ops_u.git == c3n ) { + u3_Host.ops_u.url_c = + "https://bootstrap.urbit.org/urbit-" URBIT_VERSION ".pill"; + } + else if ( u3_Host.ops_u.nuu == c3y + && u3_Host.ops_u.url_c == 0 + && u3_Host.ops_u.arv_c == 0 ) { + + fprintf(stderr, "-s only makes sense with -A\n"); + return c3n; + } + + if ( u3_Host.ops_u.pil_c != 0 ) { + struct stat s; + if ( stat(u3_Host.ops_u.pil_c, &s) != 0 ) { + fprintf(stderr, "pill %s not found\n", u3_Host.ops_u.pil_c); + return c3n; + } + } + + if ( u3_Host.ops_u.key_c != 0 ) { + struct stat s; + if ( stat(u3_Host.ops_u.key_c, &s) != 0 ) { + fprintf(stderr, "keyfile %s not found\n", u3_Host.ops_u.key_c); + return c3n; + } + } + + return c3y; +} + +/* u3_ve_usage(): print usage and exit. +*/ +static void +u3_ve_usage(c3_i argc, c3_c** argv) +{ + c3_c *use_c[] = { + "Urbit: a personal server operating function\n", + "https://urbit.org\n", + "Version " URBIT_VERSION "\n", + "\n", + "Usage: %s [options...] ship_name\n", + "where ship_name is a @p phonetic representation of an urbit address\n", + "without the leading '~', and options is some subset of the following:\n", + "\n", + // XX find a way to re-enable + // "-A dir Use dir for initial galaxy sync\n", + "-B pill Bootstrap from this pill\n", + "-b Batch create\n", + "-c pier Create a new urbit in pier/\n", + "-D Recompute from events\n", + "-d Daemon mode\n", + "-e url Ethereum gateway\n", + "-F ship Fake keys; also disables networking\n", + "-f Fuzz testing\n", + "-g Set GC flag\n", + "-j file Create json trace file\n", + "-K stage Start at Hoon kernel version stage\n", + "-k keys Private key file\n", + "-L local networking only\n", + "-P Profiling\n", + "-p ames_port Set the ames port to bind to\n", + "-q Quiet\n", + "-R Report urbit build info\n", + "-S Disable battery hashing\n", + // XX find a way to re-enable + // "-s Pill URL from arvo git hash\n", + "-u url URL from which to download pill\n", + "-v Verbose\n", + "-w name Boot as ~name\n", + "-x Exit immediately\n", + "\n", + "Development Usage:\n", + " To create a development ship, use a fakezod:\n", + " %s -F zod -A /path/to/arvo/folder -B /path/to/pill -c zod\n", + "\n", + " For more information about developing on urbit, see:\n", + " https://github.com/urbit/urbit/blob/master/CONTRIBUTING.md\n", + "\n", + "Simple Usage: \n", + " %s -c to create a comet (anonymous urbit)\n", + " %s -w -k if you own a planet\n", + " %s to restart an existing urbit\n", + 0 + }; + + c3_i i; + for ( i=0; use_c[i]; i++ ) { + fprintf(stderr, use_c[i], argv[0]); + } + exit(1); +} + +#if 0 +/* u3_ve_panic(): panic and exit. +*/ +static void +u3_ve_panic(c3_i argc, c3_c** argv) +{ + fprintf(stderr, "%s: gross system failure\n", argv[0]); + exit(1); +} +#endif + +/* u3_ve_sysopt(): apply option map to system state. +*/ +static void +u3_ve_sysopt() +{ + u3_Local = strdup(u3_Host.dir_c); +} + +static void +report(void) +{ + printf("urbit %s\n", URBIT_VERSION); + printf("---------\nLibraries\n---------\n"); + printf("gmp: %s\n", gmp_version); + printf("sigsegv: %d.%d\n", + (libsigsegv_version >> 8) & 0xff, + libsigsegv_version & 0xff); + printf("openssl: %s\n", SSLeay_version(SSLEAY_VERSION)); + printf("curses: %s\n", curses_version()); + printf("libuv: %s\n", uv_version_string()); + printf("libh2o: %d.%d.%d\n", + H2O_LIBRARY_VERSION_MAJOR, + H2O_LIBRARY_VERSION_MINOR, + H2O_LIBRARY_VERSION_PATCH); + printf("lmdb: %d.%d.%d\n", + MDB_VERSION_MAJOR, + MDB_VERSION_MINOR, + MDB_VERSION_PATCH); + printf("curl: %d.%d.%d\n", + LIBCURL_VERSION_MAJOR, + LIBCURL_VERSION_MINOR, + LIBCURL_VERSION_PATCH); + printf("argon2: 0x%x\n", ARGON2_VERSION_NUMBER); +} + +static void +_stop_exit(c3_i int_i) +{ + // explicit fprintf to avoid allocation in u3l_log + // + fprintf(stderr, "\r\n[received keyboard stop signal, exiting]\r\n"); + u3_daemon_bail(); +} + +/* + This is set to the the write-end of a pipe when Urbit is started in + daemon mode. It's meant to be used as a signal to the parent process + that the child process has finished booting. +*/ +static c3_i _child_process_booted_signal_fd = -1; + +/* + This should be called whenever the ship has been booted enough to + handle commands from automation code. Specifically, once the Eyre's + `chis` interface is up and running. + + In daemon mode, this signals to the parent process that it can + exit. Otherwise, it does nothing. + + Once we've sent a signal with `write`, we close the file descriptor + and overwrite the global to make it impossible to accidentally do + this twice. +*/ +static void _on_boot_completed_cb() { + c3_c buf[2] = {0,0}; + + if ( -1 == _child_process_booted_signal_fd ) { + return; + } + + if ( 0 == write(_child_process_booted_signal_fd, buf, 1) ) { + c3_assert(!"_on_boot_completed_cb: Can't write to parent FD"); + } + + close(_child_process_booted_signal_fd); + _child_process_booted_signal_fd = -1; +} + +/* + In daemon mode, run the urbit as a background process, but don't + exit from the parent process until the ship is finished booting. + + We use a pipe to communicate between the child and the parent. The + parent waits for the child to write something to the pipe and + then exits. If the pipe is closed with nothing written to it, get + the exit status from the child process and also exit with that status. + + We want the child to write to the pipe once it's booted, so we put + `_on_boot_completed_cb` into `u3_Host.bot_f`, which is NULL in + non-daemon mode. That gets called once the `chis` service is + available. + + In both processes, we are good fork() citizens, and close all unused + file descriptors. Closing `pipefd[1]` in the parent process is + especially important, since the pipe needs to be closed if the child + process dies. When the pipe is closed, the read fails, and that's + how we know that something went wrong. + + There are some edge cases around `WEXITSTATUS` that are not handled + here, but I don't think it matters. +*/ +static void +_fork_into_background_process() +{ + c3_i pipefd[2]; + + if ( 0 != pipe(pipefd) ) { + c3_assert(!"Failed to create pipe"); + } + + pid_t childpid = fork(); + + if ( 0 == childpid ) { + close(pipefd[0]); + _child_process_booted_signal_fd = pipefd[1]; + u3_Host.bot_f = _on_boot_completed_cb; + return; + } + + close(pipefd[1]); + close(0); + close(1); + close(2); + + c3_c buf[2] = {0,0}; + if ( 1 == read(pipefd[0], buf, 1) ) { + exit(0); + } + + c3_i status; + wait(&status); + exit(WEXITSTATUS(status)); +} + +c3_i +main(c3_i argc, + c3_c** argv) +{ + // Parse options. + // + if ( c3n == _main_getopt(argc, argv) ) { + u3_ve_usage(argc, argv); + return 1; + } + + // Set `u3_Host.wrk_c` to the worker executable path. + c3_i worker_exe_len = 1 + strlen(argv[0]) + strlen("-worker"); + u3_Host.wrk_c = c3_malloc(worker_exe_len); + snprintf(u3_Host.wrk_c, worker_exe_len, "%s-worker", argv[0]); + + // Set TERMINFO_DIRS environment variable + c3_i terminfo_len = 1 + strlen(argv[0]) + strlen("-terminfo"); + c3_c terminfo_dir[terminfo_len]; + snprintf(terminfo_dir, terminfo_len, "%s-terminfo", argv[0]); + setenv("TERMINFO_DIRS", terminfo_dir, 1); + + if ( c3y == u3_Host.ops_u.dem ) { + _fork_into_background_process(); + } + + if ( c3y == u3_Host.ops_u.rep ) { + report(); + return 0; + } + +#if 0 + if ( 0 == getuid() ) { + chroot(u3_Host.dir_c); + u3_Host.dir_c = "/"; + } +#endif + u3_ve_sysopt(); + + // Block profiling signal, which should be delivered to exactly one thread. + // + // XX review, may be unnecessary due to similar in u3m_init() + // + if ( _(u3_Host.ops_u.pro) ) { + sigset_t set; + + sigemptyset(&set); + sigaddset(&set, SIGPROF); + if ( 0 != pthread_sigmask(SIG_BLOCK, &set, NULL) ) { + u3l_log("boot: thread mask SIGPROF: %s\r\n", strerror(errno)); + exit(1); + } + } + + // Handle SIGTSTP as if it was SIGTERM. + // + // Configured here using signal() so as to be immediately available. + // + signal(SIGTSTP, _stop_exit); + + printf("~\n"); + // printf("welcome.\n"); + printf("urbit %s\n", URBIT_VERSION); + + // prints the absolute path of the pier + // + c3_c* abs_c = realpath(u3_Host.dir_c, 0); + + // if the ship is being booted, we use realpath(). Otherwise, we use getcwd() + // with a memory-allocation loop + // + if (abs_c == NULL) { + c3_i mprint_i = 1000; + abs_c = c3_malloc(mprint_i); + + // allocates more memory as needed if the path is too large + // + while ( abs_c != getcwd(abs_c, mprint_i) ) { + free(abs_c); + mprint_i *= 2; + abs_c = c3_malloc(mprint_i); + } + printf("boot: home is %s/%s\n", abs_c, u3_Host.dir_c); + free(abs_c); + } else { + printf("boot: home is %s\n", abs_c); + free(abs_c); + } + // printf("vere: hostname is %s\n", u3_Host.ops_u.nam_c); + + if ( c3y == u3_Host.ops_u.dem && c3n == u3_Host.ops_u.bat ) { + printf("boot: running as daemon\n"); + } + + // Seed prng. Don't panic -- just for fuzz testing. + // + srand(getpid()); + + // Instantiate process globals. + { + /* Boot the image and checkpoint. Set flags. + */ + { + /* Set pier directory. + */ + u3C.dir_c = u3_Host.dir_c; + + /* Logging that doesn't interfere with console output. + */ + u3C.stderr_log_f = u3_term_io_log; + + /* Set GC flag. + */ + if ( _(u3_Host.ops_u.gab) ) { + u3C.wag_w |= u3o_debug_ram; + } + + /* Set profile flag. + */ + if ( _(u3_Host.ops_u.pro) ) { + u3C.wag_w |= u3o_debug_cpu; + } + + /* Set verbose flag. + */ + if ( _(u3_Host.ops_u.veb) ) { + u3C.wag_w |= u3o_verbose; + } + + /* Set quiet flag. + */ + if ( _(u3_Host.ops_u.qui) ) { + u3C.wag_w |= u3o_quiet; + } + + /* Set dry-run flag. + */ + if ( _(u3_Host.ops_u.dry) ) { + u3C.wag_w |= u3o_dryrun; + } + + /* Set hashboard flag + */ + if ( _(u3_Host.ops_u.has) ) { + u3C.wag_w |= u3o_hashless; + } + + /* Set tracing flag + */ + if ( _(u3_Host.ops_u.tra) ) { + u3C.wag_w |= u3o_trace; + u3_Host.tra_u.nid_w = 0; + u3_Host.tra_u.fil_u = NULL; + u3_Host.tra_u.con_w = 0; + u3_Host.tra_u.fun_w = 0; + } + } + + /* Initialize OpenSSL for client and server + */ + SSL_library_init(); + SSL_load_error_strings(); + + u3_daemon_commence(); + } + return 0; +} diff --git a/pkg/hs/vere/notes/c/dawn.c b/pkg/hs/vere/notes/c/dawn.c new file mode 100644 index 000000000..80a3856aa --- /dev/null +++ b/pkg/hs/vere/notes/c/dawn.c @@ -0,0 +1,525 @@ +/* vere/dawn.c +** +** ethereum-integrated pre-boot validation +*/ +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _dawn_oct_to_buf(): +octs to uv_buf_t +*/ +static uv_buf_t +_dawn_oct_to_buf(u3_noun oct) +{ + if ( c3n == u3a_is_cat(u3h(oct)) ) { + exit(1); + } + + c3_w len_w = u3h(oct); + c3_y* buf_y = c3_malloc(1 + len_w); + buf_y[len_w] = 0; + + u3r_bytes(0, len_w, buf_y, u3t(oct)); + + u3z(oct); + return uv_buf_init((void*)buf_y, len_w); +} + +/* _dawn_buf_to_oct(): uv_buf_t to +octs +*/ +static u3_noun +_dawn_buf_to_oct(uv_buf_t buf_u) +{ + u3_noun len = u3i_words(1, (c3_w*)&buf_u.len); + + if ( c3n == u3a_is_cat(len) ) { + exit(1); + } + + return u3nc(len, u3i_bytes(buf_u.len, (const c3_y*)buf_u.base)); +} + + +/* _dawn_curl_alloc(): allocate a response buffer for curl +*/ +static size_t +_dawn_curl_alloc(void* dat_v, size_t uni_t, size_t mem_t, uv_buf_t* buf_u) +{ + size_t siz_t = uni_t * mem_t; + buf_u->base = c3_realloc(buf_u->base, 1 + siz_t + buf_u->len); + + memcpy(buf_u->base + buf_u->len, dat_v, siz_t); + buf_u->len += siz_t; + buf_u->base[buf_u->len] = 0; + + return siz_t; +} + +/* _dawn_post_json(): POST JSON to url_c +*/ +static uv_buf_t +_dawn_post_json(c3_c* url_c, uv_buf_t lod_u) +{ + CURL *curl; + CURLcode result; + long cod_l; + struct curl_slist* hed_u = 0; + + uv_buf_t buf_u = uv_buf_init(c3_malloc(1), 0); + + if ( !(curl = curl_easy_init()) ) { + u3l_log("failed to initialize libcurl\n"); + exit(1); + } + + hed_u = curl_slist_append(hed_u, "Accept: application/json"); + hed_u = curl_slist_append(hed_u, "Content-Type: application/json"); + hed_u = curl_slist_append(hed_u, "charsets: utf-8"); + + // XX require TLS, pin default cert? + + curl_easy_setopt(curl, CURLOPT_URL, url_c); + curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, _dawn_curl_alloc); + curl_easy_setopt(curl, CURLOPT_WRITEDATA, (void*)&buf_u); + curl_easy_setopt(curl, CURLOPT_HTTPHEADER, hed_u); + + // note: must be terminated! + curl_easy_setopt(curl, CURLOPT_POSTFIELDS, lod_u.base); + + result = curl_easy_perform(curl); + curl_easy_getinfo(curl, CURLINFO_RESPONSE_CODE, &cod_l); + + // XX retry? + if ( CURLE_OK != result ) { + u3l_log("failed to fetch %s: %s\n", + url_c, curl_easy_strerror(result)); + exit(1); + } + if ( 300 <= cod_l ) { + u3l_log("error fetching %s: HTTP %ld\n", url_c, cod_l); + exit(1); + } + + curl_easy_cleanup(curl); + curl_slist_free_all(hed_u); + + return buf_u; +} + +/* _dawn_get_jam(): GET a jammed noun from url_c +*/ +static u3_noun +_dawn_get_jam(c3_c* url_c) +{ + CURL *curl; + CURLcode result; + long cod_l; + + uv_buf_t buf_u = uv_buf_init(c3_malloc(1), 0); + + if ( !(curl = curl_easy_init()) ) { + u3l_log("failed to initialize libcurl\n"); + exit(1); + } + + // XX require TLS, pin default cert? + + curl_easy_setopt(curl, CURLOPT_URL, url_c); + curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, _dawn_curl_alloc); + curl_easy_setopt(curl, CURLOPT_WRITEDATA, (void*)&buf_u); + + result = curl_easy_perform(curl); + curl_easy_getinfo(curl, CURLINFO_RESPONSE_CODE, &cod_l); + + // XX retry? + if ( CURLE_OK != result ) { + u3l_log("failed to fetch %s: %s\n", + url_c, curl_easy_strerror(result)); + exit(1); + } + if ( 300 <= cod_l ) { + u3l_log("error fetching %s: HTTP %ld\n", url_c, cod_l); + exit(1); + } + + curl_easy_cleanup(curl); + + // throw away the length from the octs + // + u3_noun octs = _dawn_buf_to_oct(buf_u); + u3_noun jammed = u3k(u3t(octs)); + u3z(octs); + + return u3ke_cue(jammed); +} + +/* _dawn_eth_rpc(): ethereum JSON RPC with request/response as +octs +*/ +static u3_noun +_dawn_eth_rpc(c3_c* url_c, u3_noun oct) +{ + return _dawn_buf_to_oct(_dawn_post_json(url_c, _dawn_oct_to_buf(oct))); +} + +/* _dawn_fail(): pre-boot validation failed +*/ +static void +_dawn_fail(u3_noun who, u3_noun rac, u3_noun sas) +{ + u3_noun how = u3dc("scot", 'p', u3k(who)); + c3_c* how_c = u3r_string(u3k(how)); + + c3_c* rac_c; + + switch (rac) { + default: c3_assert(0); + case c3__czar: { + rac_c = "galaxy"; + break; + } + case c3__king: { + rac_c = "star"; + break; + } + case c3__duke: { + rac_c = "planet"; + break; + } + case c3__earl: { + rac_c = "moon"; + break; + } + case c3__pawn: { + rac_c = "comet"; + break; + } + } + + u3l_log("boot: invalid keys for %s '%s'\r\n", rac_c, how_c); + + // XX deconstruct sas, print helpful error messages + u3m_p("pre-boot error", u3t(sas)); + + u3z(how); + free(how_c); + exit(1); +} + +/* _dawn_need_unit(): produce a value or print error and exit +*/ +static u3_noun +_dawn_need_unit(u3_noun nit, c3_c* msg_c) +{ + if ( u3_nul == nit ) { + u3l_log("%s\r\n", msg_c); + exit(1); + } + else { + u3_noun pro = u3k(u3t(nit)); + u3z(nit); + return pro; + } +} + +/* _dawn_purl(): ethereum gateway url as (unit purl) +*/ +static u3_noun +_dawn_purl(u3_noun rac) +{ + u3_noun url; + + if ( 0 == u3_Host.ops_u.eth_c ) { + if ( c3__czar == rac ) { + u3l_log("boot: galaxy requires ethereum gateway via -e\r\n"); + exit(1); + } + + url = u3_nul; + } + else { + // XX call de-purl directly + // + u3_noun par = u3v_wish("auru:de-purl:html"); + u3_noun lur = u3i_string(u3_Host.ops_u.eth_c); + u3_noun rul = u3dc("rush", u3k(lur), u3k(par)); + + if ( u3_nul == rul ) { + if ( c3__czar == rac ) { + u3l_log("boot: galaxy requires ethereum gateway via -e\r\n"); + exit(1); + } + + url = u3_nul; + } + else { + // XX revise for de-purl + // auru:de-purl:html parses to (pair user purl) + // we need (unit purl) + // + url = u3nc(u3_nul, u3k(u3t(u3t(rul)))); + } + + u3z(par); u3z(lur); u3z(rul); + } + + return url; +} + +/* _dawn_turf(): override contract domains with -H +*/ +static u3_noun +_dawn_turf(c3_c* dns_c) +{ + u3_noun tuf; + + u3_noun par = u3v_wish("thos:de-purl:html"); + u3_noun dns = u3i_string(dns_c); + u3_noun rul = u3dc("rush", u3k(dns), u3k(par)); + + if ( (u3_nul == rul) || (c3n == u3h(u3t(rul))) ) { + u3l_log("boot: invalid domain specified with -H %s\r\n", dns_c); + exit(1); + } + else { + u3l_log("boot: overriding network domains with %s\r\n", dns_c); + u3_noun dom = u3t(u3t(rul)); + tuf = u3nc(u3k(dom), u3_nul); + } + + u3z(par); u3z(dns); u3z(rul); + + return tuf; +} + +/* u3_dawn_vent(): validated boot event +*/ +u3_noun +u3_dawn_vent(u3_noun seed) +{ + u3_noun url, bok, pon, zar, tuf, sap; + + u3_noun ship = u3h(seed); + u3_noun rank = u3do("clan:title", u3k(ship)); + + // load snapshot from file + // + if ( 0 != u3_Host.ops_u.ets_c ) { + u3l_log("boot: loading azimuth snapshot\r\n"); + u3_noun raw_snap = u3ke_cue(u3m_file(u3_Host.ops_u.ets_c)); + sap = u3nc(u3_nul, raw_snap); + } + // load snapshot from HTTP URL + // + else if ( 0 != u3_Host.ops_u.sap_c ) { + u3l_log("boot: downloading azimuth snapshot from %s\r\n", + u3_Host.ops_u.sap_c); + u3_noun raw_snap = _dawn_get_jam(u3_Host.ops_u.sap_c); + sap = u3nc(u3_nul, raw_snap); + } + // no snapshot + // + else { + u3l_log("boot: no azimuth snapshot specified\n"); + sap = u3_nul; + } + + url = _dawn_purl(rank); + + // XX require https? + // + c3_c* url_c = ( 0 != u3_Host.ops_u.eth_c ) ? + u3_Host.ops_u.eth_c : + "https://mainnet.infura.io/v3/196a7f37c7d54211b4a07904ec73ad87"; + + // pin block number + // + if ( c3y == u3_Host.ops_u.etn ) { + u3l_log("boot: extracting block from snapshot\r\n"); + + bok = _dawn_need_unit(u3do("bloq:snap:dawn", u3k(u3t(sap))), + "boot: failed to extract " + "block from snapshot"); + } + else { + u3l_log("boot: retrieving latest block\r\n"); + + u3_noun oct = u3v_wish("bloq:give:dawn"); + u3_noun kob = _dawn_eth_rpc(url_c, u3k(oct)); + + bok = _dawn_need_unit(u3do("bloq:take:dawn", u3k(kob)), + "boot: block retrieval failed"); + u3z(oct); u3z(kob); + } + + { + // +point:azimuth: on-chain state + // + u3_noun pot; + + if ( c3y == u3_Host.ops_u.etn ) { + u3l_log("boot: extracting public keys from snapshot\r\n"); + + pot = _dawn_need_unit(u3dc("point:snap:dawn", u3k(ship), u3k(u3t(sap))), + "boot: failed to extract " + "public keys from snapshot"); + } + else if ( c3__pawn == rank ) { + // irrelevant, just bunt +point + // + pot = u3v_wish("*point:azimuth"); + } + else { + u3_noun who; + + if ( c3__earl == rank ) { + who = u3do("^sein:title", u3k(ship)); + + { + u3_noun seg = u3dc("scot", 'p', u3k(who)); + c3_c* seg_c = u3r_string(seg); + + u3l_log("boot: retrieving %s's public keys (for %s)\r\n", + seg_c, u3_Host.ops_u.who_c); + free(seg_c); + u3z(seg); + } + } + else { + who = u3k(ship); + u3l_log("boot: retrieving %s's public keys\r\n", + u3_Host.ops_u.who_c); + } + + { + u3_noun oct = u3dc("point:give:dawn", u3k(bok), u3k(who)); + u3_noun luh = _dawn_eth_rpc(url_c, u3k(oct)); + + pot = _dawn_need_unit(u3dc("point:take:dawn", u3k(ship), u3k(luh)), + "boot: failed to retrieve public keys"); + u3z(oct); u3z(luh); + } + + u3z(who); + } + + // +live:dawn: network state + // XX actually make request + // + u3_noun liv = u3_nul; + // u3_noun liv = _dawn_get_json(parent, /some/url) + + u3l_log("boot: verifying keys\r\n"); + + // (each sponsor=ship error=@tas) + // + u3_noun sas = u3dt("veri:dawn", u3k(seed), u3k(pot), u3k(liv)); + + if ( c3n == u3h(sas) ) { + // bails, won't return + _dawn_fail(ship, rank, sas); + return u3_none; + } + + // ship: sponsor + // produced by +veri:dawn to avoid coupling to +point structure + // XX reconsider + // + pon = u3k(u3t(sas)); + + u3z(pot); u3z(liv); u3z(sas); + } + + // (map ship [=life =pass]): galaxy table + // + if ( c3y == u3_Host.ops_u.etn ) { + u3l_log("boot: extracting galaxy table from snapshot\r\n"); + + zar = _dawn_need_unit(u3do("czar:snap:dawn", u3k(u3t(sap))), + "boot: failed to extract " + "galaxy table from snapshot"); + } + else { + u3l_log("boot: retrieving galaxy table\r\n"); + + u3_noun oct = u3do("czar:give:dawn", u3k(bok)); + u3_noun raz = _dawn_eth_rpc(url_c, u3k(oct)); + + zar = _dawn_need_unit(u3do("czar:take:dawn", u3k(raz)), + "boot: failed to retrieve galaxy table"); + u3z(oct); u3z(raz); + } + + // (list turf): ames domains + // + if ( 0 != u3_Host.ops_u.dns_c ) { + tuf = _dawn_turf(u3_Host.ops_u.dns_c); + } + else if ( c3y == u3_Host.ops_u.etn ) { + u3l_log("boot: extracting network domains from snapshot\r\n"); + + tuf = _dawn_need_unit(u3do("turf:snap:dawn", u3k(u3t(sap))), + "boot: failed to extract " + "network domains from snapshot"); + } + else { + u3l_log("boot: retrieving network domains\r\n"); + + u3_noun oct = u3do("turf:give:dawn", u3k(bok)); + u3_noun fut = _dawn_eth_rpc(url_c, u3k(oct)); + + tuf = _dawn_need_unit(u3do("turf:take:dawn", u3k(fut)), + "boot: failed to retrieve network domains"); + u3z(oct); u3z(fut); + } + + u3z(rank); + + // [%dawn seed sponsor galaxies domains block eth-url snap] + // + return u3nc(c3__dawn, u3nq(seed, pon, zar, u3nq(tuf, bok, url, sap))); +} + +/* _dawn_come(): mine a comet under a list of stars +*/ +static u3_noun +_dawn_come(u3_noun stars) +{ + u3_noun seed; + { + c3_w eny_w[16]; + u3_noun eny; + + c3_rand(eny_w); + eny = u3i_words(16, eny_w); + + u3l_log("boot: mining a comet. May take up to an hour.\r\n"); + u3l_log("If you want to boot faster, get an Azimuth point.\r\n"); + + seed = u3dc("come:dawn", u3k(stars), u3k(eny)); + u3z(eny); + } + + { + u3_noun who = u3dc("scot", 'p', u3k(u3h(seed))); + c3_c* who_c = u3r_string(who); + + u3l_log("boot: found comet %s\r\n", who_c); + free(who_c); + u3z(who); + } + + u3z(stars); + + return seed; +} + +/* u3_dawn_come(): mine a comet under a list of stars we download +*/ +u3_noun +u3_dawn_come() +{ + return _dawn_come( + _dawn_get_jam("https://bootstrap.urbit.org/comet-stars.jam")); +} diff --git a/pkg/hs/vere/notes/c/foil.c b/pkg/hs/vere/notes/c/foil.c new file mode 100644 index 000000000..4bd4a401a --- /dev/null +++ b/pkg/hs/vere/notes/c/foil.c @@ -0,0 +1,170 @@ +/* vere/foil.c +** +** This file is in the public domain. +*/ + +#include "all.h" + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "vere/vere.h" + + /* assumptions: + ** all measurements are in chubs (double-words, c3_d, uint64_t). + ** little-endian addressing is ASSUMED. + ** + ** framing: + ** the last two chubs of a frame: + ** + ** { + ** 64-bit frame length + ** { + ** (high 32 bits) mug of frame + ** (low 32 bits) mug of current address + ** } + ** } + ** + ** we can scan for one of these frames with very low probability + ** of a false positive. we always write to and read from the end + ** of a file. a frame position points to its end. + ** + ** protocol: + ** once the callback is called, all results are fully fsynced. + ** all callbacks are optional and can be passed 0. + */ + +/* _foil_fail(): fail with error. +*/ +static void +_foil_fail(const c3_c* why_c, c3_i err_i) +{ + if ( err_i ) { + u3l_log("%s: error: %s\r\n", why_c, uv_strerror(err_i)); + c3_assert(0); + } else { + u3l_log("%s: file error\r\n", why_c); + } + exit(1); +} + +/* _foil_close(): close file, blockingly. +*/ +static void +_foil_close(uv_file fil_f) +{ + c3_i err_i; + uv_fs_t ruq_u; + + if ( 0 != (err_i = uv_fs_close(u3L, &ruq_u, fil_f, 0)) ) { + _foil_fail("uv_fs_close", err_i); + } +} + +/* _foil_path(): allocate path. +*/ +static c3_c* +_foil_path(u3_dire* dir_u, + const c3_c* nam_c) +{ + c3_w len_w = strlen(dir_u->pax_c); + c3_c* pax_c; + + pax_c = c3_malloc(1 + len_w + 1 + strlen(nam_c)); + strcpy(pax_c, dir_u->pax_c); + pax_c[len_w] = '/'; + strcpy(pax_c + len_w + 1, nam_c); + + return pax_c; +} + +/* u3_foil_folder(): load directory, blockingly. null if nonexistent. +*/ +u3_dire* +u3_foil_folder(const c3_c* pax_c) +{ + u3_dire* dir_u; + uv_fs_t ruq_u; + uv_dirent_t den_u; + c3_i err_i; + + /* open directory, synchronously + */ + { + err_i = uv_fs_scandir(u3L, &ruq_u, pax_c, 0, 0); + + if ( err_i < 0 ) { + if ( UV_ENOENT != err_i ) { + _foil_fail(pax_c, err_i); + return 0; + } + else { + if ( 0 != (err_i = uv_fs_mkdir(u3L, &ruq_u, pax_c, 0700, 0)) ) { + _foil_fail(pax_c, err_i); + return 0; + } + else { + uv_fs_req_cleanup(&ruq_u); + return u3_foil_folder(pax_c); + } + } + } + dir_u = c3_malloc(sizeof *dir_u); + dir_u->all_u = 0; + dir_u->pax_c = c3_malloc(1 + strlen(pax_c)); + strcpy(dir_u->pax_c, pax_c); + } + + /* create entries for all files + */ + while ( UV_EOF != uv_fs_scandir_next(&ruq_u, &den_u) ) { + if ( UV_DIRENT_FILE == den_u.type ) { + u3_dent* det_u = c3_malloc(sizeof(*det_u)); + + det_u->nam_c = c3_malloc(1 + strlen(den_u.name)); + strcpy(det_u->nam_c, den_u.name); + + det_u->nex_u = dir_u->all_u; + dir_u->all_u = det_u; + } + } + + /* clean up request + */ + { + uv_fs_req_cleanup(&ruq_u); + } + + /* open directory file for reading, to fsync + */ + { + if ( 0 > (err_i = uv_fs_open(u3L, + &ruq_u, + pax_c, + O_RDONLY, + 0600, + 0)) ) + { + _foil_fail("open directory", err_i); + return 0; + } + dir_u->fil_u = ruq_u.result; + + uv_fs_req_cleanup(&ruq_u); + } + return dir_u; +} diff --git a/pkg/hs/vere/notes/c/hash_tests.c b/pkg/hs/vere/notes/c/hash_tests.c new file mode 100644 index 000000000..a362fec10 --- /dev/null +++ b/pkg/hs/vere/notes/c/hash_tests.c @@ -0,0 +1,105 @@ +#include "all.h" + +/* _setup(): prepare for tests. +*/ +static void +_setup(void) +{ + u3m_init(); + u3m_pave(c3y, c3n); +} + +/* _test_mug(): spot check u3r_mug hashes. +*/ +static void +_test_mug(void) +{ + if ( 0x4d441035 != u3r_mug_string("Hello, world!") ) { + fprintf(stderr, "fail (a)\r\n"); + exit(1); + } + + if ( 0x4d441035 != u3r_mug(u3i_string("Hello, world!")) ) { + fprintf(stderr, "fail (b)\r\n"); + exit(1); + } + + if ( 0x79ff04e8 != u3r_mug_bytes(0, 0) ) { + fprintf(stderr, "fail (c)\r\n"); + exit(1); + } + + if ( 0x64dfda5c != u3r_mug(u3i_string("xxxxxxxxxxxxxxxxxxxxxxxxxxxx")) ) { + fprintf(stderr, "fail (d)\r\n"); + exit(1); + } + + if ( 0x389ca03a != u3r_mug_cell(0, 0) ) { + fprintf(stderr, "fail (e)\r\n"); + exit(1); + } + + if ( 0x389ca03a != u3r_mug_cell(1, 1) ) { + fprintf(stderr, "fail (f)\r\n"); + exit(1); + } + + if ( 0x5258a6c0 != u3r_mug_cell(0, u3qc_bex(32)) ) { + fprintf(stderr, "fail (g)\r\n"); + exit(1); + } + + if ( 0x2ad39968 != u3r_mug_cell(u3qa_dec(u3qc_bex(128)), 1) ) { + fprintf(stderr, "fail (h)\r\n"); + exit(1); + } + + { + // stick some zero bytes in a string + // + u3_noun str = u3kc_lsh(3, 1, + u3kc_mix(u3qc_bex(212), + u3i_string("abcdefjhijklmnopqrstuvwxyz"))); + + c3_w byt_w = u3r_met(3, str); + c3_w wor_w = u3r_met(5, str); + c3_y* str_y = c3_malloc(byt_w); + c3_w* str_w = c3_malloc(4 * wor_w); + c3_d str_d = 0; + + u3r_bytes(0, byt_w, str_y, str); + u3r_words(0, wor_w, str_w, str); + + str_d |= str_w[0]; + str_d |= ((c3_d)str_w[1] << 32ULL); + + if ( 0x34d08717 != u3r_mug(str) ) { + fprintf(stderr, "fail (i) (1) \r\n"); + exit(1); + } + if ( 0x34d08717 != u3r_mug_bytes(str_y, byt_w) ) { + fprintf(stderr, "fail (i) (2)\r\n"); + exit(1); + } + if ( 0x34d08717 != u3r_mug_words(str_w, wor_w) ) { + fprintf(stderr, "fail (i) (3)\r\n"); + exit(1); + } + if ( u3r_mug_words(str_w, 2) != u3r_mug_chub(str_d) ) { + fprintf(stderr, "fail (i) (4)\r\n"); + exit(1); + } + } +} + +/* main(): run all test cases. +*/ +int +main(int argc, char* argv[]) +{ + _setup(); + + _test_mug(); + + return 0; +} diff --git a/pkg/hs/vere/notes/c/hashtable_tests.c b/pkg/hs/vere/notes/c/hashtable_tests.c new file mode 100644 index 000000000..8955a000d --- /dev/null +++ b/pkg/hs/vere/notes/c/hashtable_tests.c @@ -0,0 +1,144 @@ +#include "all.h" + +static void _setup(void); +static void _test_cache_replace_value(void); +static void _test_cache_trimming(void); +static void _test_no_cache(void); +static void _test_skip_slot(void); + +// defined in noun/hashtable.c +c3_w _ch_skip_slot(c3_w mug_w, c3_w lef_w); + + +/* main(): run all test cases. +*/ +int +main(int argc, char* argv[]) +{ + _setup(); + + _test_no_cache(); + _test_skip_slot(); + _test_cache_trimming(); + _test_cache_replace_value(); + + return 0; +} + +/* _setup(): prepare for tests. +*/ +static void +_setup(void) +{ + u3m_init(); + u3m_pave(c3y, c3n); +} + +/* _test_no_cache(): test a hashtable without caching. +*/ +static void +_test_no_cache(void) +{ + c3_w i_w; + c3_w max_w = 1000; + + u3p(u3h_root) har_p = u3h_new(); + + for ( i_w = 0; i_w < max_w; i_w++ ) { + u3h_put(har_p, i_w, i_w + max_w); + } + + for ( i_w = 0; i_w < max_w; i_w++ ) { + c3_assert(i_w + max_w == u3h_get(har_p, i_w)); + } + printf("test_no_cache: ok\n"); +} + +/* _test_skip_slot(): +*/ +static void +_test_skip_slot(void) +{ + // root table + { + c3_w mug_w = 0x17 << 25; + c3_w res_w = _ch_skip_slot(mug_w, 25); + c3_assert((0x18 << 25) == res_w); + } + + { + c3_w mug_w = 63 << 25; // 6 bits, all ones + c3_w res_w = _ch_skip_slot(mug_w, 25); + c3_assert(0 == res_w); + } + + // child nodes + { + c3_w mug_w = 17 << 20; + c3_w res_w = _ch_skip_slot(mug_w, 20); + c3_assert((18 << 20) == res_w); + } + + { + c3_w mug_w = 31 << 20; // 5 bits, all ones + c3_w res_w = _ch_skip_slot(mug_w, 20); + c3_assert((1 << 25) == res_w); + } + + fprintf(stderr, "test_skip_slot: ok\n"); +} + +/* _test_cache_trimming(): ensure a caching hashtable removes stale items. +*/ +static void +_test_cache_trimming(void) +{ + c3_w max_w = 620; + c3_w i_w; + + //u3p(u3h_root) har_p = u3h_new_cache(max_w / 2); + u3p(u3h_root) har_p = u3h_new_cache(max_w / 10 ); + u3h_root* har_u = u3to(u3h_root, har_p); + + for ( i_w = 0; i_w < max_w; i_w++ ) { + u3h_put(har_p, i_w, i_w + max_w); + } + + if ( ( max_w + max_w - 1) != u3h_get(har_p, max_w - 1) ) { + fprintf(stderr, "fail\r\n"); + exit(1); + } + if ( ( max_w / 10 ) != har_u->use_w ) { + fprintf(stderr, "fail\r\n"); + exit(1); + } + fprintf(stderr, "test_cache_trimming: ok\n"); +} + +static void +_test_cache_replace_value(void) +{ + c3_w max_w = 100; + c3_w i_w; + + u3p(u3h_root) har_p = u3h_new_cache(max_w); + u3h_root* har_u = u3to(u3h_root, har_p); + + for ( i_w = 0; i_w < max_w; i_w++ ) { + u3h_put(har_p, i_w, i_w + max_w); + } + + for ( i_w = 0; i_w < max_w; i_w++ ) { + u3h_put(har_p, i_w, i_w + max_w + 1); + } + + if ( (2 * max_w) != u3h_get(har_p, max_w - 1) ) { + fprintf(stderr, "fail\r\n"); + exit(1); + } + if ( max_w != har_u->use_w ) { + fprintf(stderr, "fail\r\n"); + exit(1); + } + fprintf(stderr, "test_cache_replace_value: ok\r\n"); +} diff --git a/pkg/hs/vere/notes/c/http.c b/pkg/hs/vere/notes/c/http.c new file mode 100644 index 000000000..11dbe0bdd --- /dev/null +++ b/pkg/hs/vere/notes/c/http.c @@ -0,0 +1,2908 @@ +/* vere/http.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +typedef struct _u3_h2o_serv { + h2o_globalconf_t fig_u; // h2o global config + h2o_context_t ctx_u; // h2o ctx + h2o_accept_ctx_t cep_u; // h2o accept ctx + h2o_hostconf_t* hos_u; // h2o host config + h2o_handler_t* han_u; // h2o request handler +} u3_h2o_serv; + +static void _proxy_serv_free(u3_prox* lis_u); +static void _proxy_serv_close(u3_prox* lis_u); +static u3_prox* _proxy_serv_new(u3_http* htp_u, c3_s por_s, c3_o sec); +static u3_prox* _proxy_serv_start(u3_prox* lis_u); + +static void _http_serv_free(u3_http* htp_u); +static void _http_serv_start_all(void); +static void _http_form_free(void); + +static const c3_i TCP_BACKLOG = 16; + +// XX temporary, add to u3_http_ef_form +// +#define PROXY_DOMAIN "arvo.network" + +/* _http_vec_to_meth(): convert h2o_iovec_t to meth +*/ +static u3_weak +_http_vec_to_meth(h2o_iovec_t vec_u) +{ + return ( 0 == strncmp(vec_u.base, "GET", vec_u.len) ) ? c3__get : + ( 0 == strncmp(vec_u.base, "PUT", vec_u.len) ) ? c3__put : + ( 0 == strncmp(vec_u.base, "POST", vec_u.len) ) ? c3__post : + ( 0 == strncmp(vec_u.base, "HEAD", vec_u.len) ) ? c3__head : + ( 0 == strncmp(vec_u.base, "CONNECT", vec_u.len) ) ? c3__conn : + ( 0 == strncmp(vec_u.base, "DELETE", vec_u.len) ) ? c3__delt : + ( 0 == strncmp(vec_u.base, "OPTIONS", vec_u.len) ) ? c3__opts : + ( 0 == strncmp(vec_u.base, "TRACE", vec_u.len) ) ? c3__trac : + // TODO ?? + // ( 0 == strncmp(vec_u.base, "PATCH", vec_u.len) ) ? c3__patc : + u3_none; +} + +/* _http_vec_to_atom(): convert h2o_iovec_t to atom (cord) +*/ +static u3_noun +_http_vec_to_atom(h2o_iovec_t vec_u) +{ + return u3i_bytes(vec_u.len, (const c3_y*)vec_u.base); +} + +/* _http_vec_to_octs(): convert h2o_iovec_t to (unit octs) +*/ +static u3_noun +_http_vec_to_octs(h2o_iovec_t vec_u) +{ + if ( 0 == vec_u.len ) { + return u3_nul; + } + + // XX correct size_t -> atom? + return u3nt(u3_nul, u3i_chubs(1, (const c3_d*)&vec_u.len), + _http_vec_to_atom(vec_u)); +} + +/* _http_vec_from_octs(): convert (unit octs) to h2o_iovec_t +*/ +static h2o_iovec_t +_http_vec_from_octs(u3_noun oct) +{ + if ( u3_nul == oct ) { + return h2o_iovec_init(0, 0); + } + + // 2GB max + if ( c3n == u3a_is_cat(u3h(u3t(oct))) ) { + u3m_bail(c3__fail); + } + + c3_w len_w = u3h(u3t(oct)); + c3_y* buf_y = c3_malloc(1 + len_w); + buf_y[len_w] = 0; + + u3r_bytes(0, len_w, buf_y, u3t(u3t(oct))); + + u3z(oct); + return h2o_iovec_init(buf_y, len_w); +} + +/* _http_heds_to_noun(): convert h2o_header_t to (list (pair @t @t)) +*/ +static u3_noun +_http_heds_to_noun(h2o_header_t* hed_u, c3_d hed_d) +{ + u3_noun hed = u3_nul; + c3_d dex_d = hed_d; + + h2o_header_t deh_u; + + while ( 0 < dex_d ) { + deh_u = hed_u[--dex_d]; + hed = u3nc(u3nc(_http_vec_to_atom(*deh_u.name), + _http_vec_to_atom(deh_u.value)), hed); + } + + return hed; +} + +/* _http_heds_free(): free header linked list +*/ +static void +_http_heds_free(u3_hhed* hed_u) +{ + while ( hed_u ) { + u3_hhed* nex_u = hed_u->nex_u; + + free(hed_u->nam_c); + free(hed_u->val_c); + free(hed_u); + hed_u = nex_u; + } +} + +/* _http_hed_new(): create u3_hhed from nam/val cords +*/ +static u3_hhed* +_http_hed_new(u3_atom nam, u3_atom val) +{ + c3_w nam_w = u3r_met(3, nam); + c3_w val_w = u3r_met(3, val); + u3_hhed* hed_u = c3_malloc(sizeof(*hed_u)); + + hed_u->nam_c = c3_malloc(1 + nam_w); + hed_u->val_c = c3_malloc(1 + val_w); + hed_u->nam_c[nam_w] = 0; + hed_u->val_c[val_w] = 0; + hed_u->nex_u = 0; + hed_u->nam_w = nam_w; + hed_u->val_w = val_w; + + u3r_bytes(0, nam_w, (c3_y*)hed_u->nam_c, nam); + u3r_bytes(0, val_w, (c3_y*)hed_u->val_c, val); + + return hed_u; +} + +/* _http_heds_from_noun(): convert (list (pair @t @t)) to u3_hhed +*/ +static u3_hhed* +_http_heds_from_noun(u3_noun hed) +{ + u3_noun deh = hed; + u3_noun i_hed; + + u3_hhed* hed_u = 0; + + while ( u3_nul != hed ) { + i_hed = u3h(hed); + u3_hhed* nex_u = _http_hed_new(u3h(i_hed), u3t(i_hed)); + nex_u->nex_u = hed_u; + + hed_u = nex_u; + hed = u3t(hed); + } + + u3z(deh); + return hed_u; +} + +/* _http_req_find(): find http request in connection by sequence. +*/ +static u3_hreq* +_http_req_find(u3_hcon* hon_u, c3_w seq_l) +{ + u3_hreq* req_u = hon_u->req_u; + + // XX glories of linear search + // + while ( req_u ) { + if ( seq_l == req_u->seq_l ) { + return req_u; + } + req_u = req_u->nex_u; + } + return 0; +} + +/* _http_req_link(): link http request to connection +*/ +static void +_http_req_link(u3_hcon* hon_u, u3_hreq* req_u) +{ + req_u->hon_u = hon_u; + req_u->seq_l = hon_u->seq_l++; + req_u->nex_u = hon_u->req_u; + + if ( 0 != req_u->nex_u ) { + req_u->nex_u->pre_u = req_u; + } + hon_u->req_u = req_u; +} + +/* _http_req_unlink(): remove http request from connection +*/ +static void +_http_req_unlink(u3_hreq* req_u) +{ + if ( 0 != req_u->pre_u ) { + req_u->pre_u->nex_u = req_u->nex_u; + + if ( 0 != req_u->nex_u ) { + req_u->nex_u->pre_u = req_u->pre_u; + } + } + else { + req_u->hon_u->req_u = req_u->nex_u; + + if ( 0 != req_u->nex_u ) { + req_u->nex_u->pre_u = 0; + } + } +} + +/* _http_req_to_duct(): translate srv/con/req to duct +*/ +static u3_noun +_http_req_to_duct(u3_hreq* req_u) +{ + return u3nt(u3_blip, c3__http, + u3nq(u3dc("scot", c3_s2('u','v'), req_u->hon_u->htp_u->sev_l), + u3dc("scot", c3_s2('u','d'), req_u->hon_u->coq_l), + u3dc("scot", c3_s2('u','d'), req_u->seq_l), + u3_nul)); +} + +/* _http_req_kill(): kill http request in %eyre. +*/ +static void +_http_req_kill(u3_hreq* req_u) +{ + u3_noun pox = _http_req_to_duct(req_u); + u3_pier_plan(pox, u3nc(c3__thud, u3_nul)); +} + +/* _http_req_done(): request finished, deallocation callback +*/ +static void +_http_req_done(void* ptr_v) +{ + u3_hreq* req_u = (u3_hreq*)ptr_v; + + // client canceled request + if ( u3_rsat_plan == req_u->sat_e ) { + _http_req_kill(req_u); + } + + if ( 0 != req_u->tim_u ) { + uv_close((uv_handle_t*)req_u->tim_u, (uv_close_cb)free); + req_u->tim_u = 0; + } + + _http_req_unlink(req_u); +} + +/* _http_req_timer_cb(): request timeout callback +*/ +static void +_http_req_timer_cb(uv_timer_t* tim_u) +{ + u3_hreq* req_u = tim_u->data; + + if ( u3_rsat_plan == req_u->sat_e ) { + _http_req_kill(req_u); + req_u->sat_e = u3_rsat_ripe; + + c3_c* msg_c = "gateway timeout"; + h2o_send_error_generic(req_u->rec_u, 504, msg_c, msg_c, 0); + } +} + +/* _http_req_new(): receive http request. +*/ +static u3_hreq* +_http_req_new(u3_hcon* hon_u, h2o_req_t* rec_u) +{ + u3_hreq* req_u = h2o_mem_alloc_shared(&rec_u->pool, sizeof(*req_u), + _http_req_done); + req_u->rec_u = rec_u; + req_u->sat_e = u3_rsat_init; + req_u->tim_u = 0; + req_u->pre_u = 0; + + _http_req_link(hon_u, req_u); + + return req_u; +} + +/* _http_req_dispatch(): dispatch http request to %eyre +*/ +static void +_http_req_dispatch(u3_hreq* req_u, u3_noun req) +{ + c3_assert(u3_rsat_init == req_u->sat_e); + req_u->sat_e = u3_rsat_plan; + + u3_noun pox = _http_req_to_duct(req_u); + u3_noun typ = _(req_u->hon_u->htp_u->lop) ? c3__chis : c3__this; + + u3_pier_plan(pox, u3nq(typ, + req_u->hon_u->htp_u->sec, + u3nc(c3y, u3i_words(1, &req_u->hon_u->ipf_w)), + req)); +} + +typedef struct _u3_hgen { + h2o_generator_t neg_u; + h2o_iovec_t bod_u; + u3_hhed* hed_u; +} u3_hgen; + +/* _http_hgen_dispose(): dispose response generator and buffers +*/ +static void +_http_hgen_dispose(void* ptr_v) +{ + u3_hgen* gen_u = (u3_hgen*)ptr_v; + _http_heds_free(gen_u->hed_u); + free(gen_u->bod_u.base); +} + +/* _http_req_respond(): write httr to h2o_req_t->res and send +*/ +static void +_http_req_respond(u3_hreq* req_u, u3_noun sas, u3_noun hed, u3_noun bod) +{ + // XX ideally + //c3_assert(u3_rsat_plan == req_u->sat_e); + + if ( u3_rsat_plan != req_u->sat_e ) { + //u3l_log("duplicate response\n"); + return; + } + + req_u->sat_e = u3_rsat_ripe; + + uv_timer_stop(req_u->tim_u); + + h2o_req_t* rec_u = req_u->rec_u; + + rec_u->res.status = sas; + rec_u->res.reason = (sas < 200) ? "weird" : + (sas < 300) ? "ok" : + (sas < 400) ? "moved" : + (sas < 500) ? "missing" : + "hosed"; + + u3_hhed* hed_u = _http_heds_from_noun(u3k(hed)); + + u3_hgen* gen_u = h2o_mem_alloc_shared(&rec_u->pool, sizeof(*gen_u), + _http_hgen_dispose); + gen_u->neg_u = (h2o_generator_t){0, 0}; + gen_u->hed_u = hed_u; + + while ( 0 != hed_u ) { + h2o_add_header_by_str(&rec_u->pool, &rec_u->res.headers, + hed_u->nam_c, hed_u->nam_w, 0, 0, + hed_u->val_c, hed_u->val_w); + hed_u = hed_u->nex_u; + } + + gen_u->bod_u = _http_vec_from_octs(u3k(bod)); + rec_u->res.content_length = gen_u->bod_u.len; + + h2o_start_response(rec_u, &gen_u->neg_u); + h2o_send(rec_u, &gen_u->bod_u, 1, H2O_SEND_STATE_FINAL); + + { + u3_h2o_serv* h2o_u = req_u->hon_u->htp_u->h2o_u; + + if ( 0 != h2o_u->ctx_u.shutdown_requested ) { + rec_u->http1_is_persistent = 0; + } + } + + u3z(sas); u3z(hed); u3z(bod); +} + +/* _http_rec_to_httq(): convert h2o_req_t to httq +*/ +static u3_weak +_http_rec_to_httq(h2o_req_t* rec_u) +{ + u3_noun med = _http_vec_to_meth(rec_u->method); + + if ( u3_none == med ) { + return u3_none; + } + + u3_noun url = _http_vec_to_atom(rec_u->path); + u3_noun hed = _http_heds_to_noun(rec_u->headers.entries, + rec_u->headers.size); + + // restore host header + hed = u3nc(u3nc(u3i_string("host"), + _http_vec_to_atom(rec_u->authority)), + hed); + + u3_noun bod = _http_vec_to_octs(rec_u->entity); + + return u3nq(med, url, hed, bod); +} + +typedef struct _h2o_uv_sock { // see private st_h2o_uv_socket_t + h2o_socket_t sok_u; // socket + uv_stream_t* han_u; // client stream handler (u3_hcon) +} h2o_uv_sock; + +/* _http_rec_accept(); handle incoming http request from h2o. +*/ +static c3_i +_http_rec_accept(h2o_handler_t* han_u, h2o_req_t* rec_u) +{ + u3_weak req = _http_rec_to_httq(rec_u); + + if ( u3_none == req ) { + if ( (u3C.wag_w & u3o_verbose) ) { + u3l_log("strange %.*s request\n", (int)rec_u->method.len, + rec_u->method.base); + } + c3_c* msg_c = "bad request"; + h2o_send_error_generic(rec_u, 400, msg_c, msg_c, 0); + } + else { + h2o_uv_sock* suv_u = (h2o_uv_sock*)rec_u->conn-> + callbacks->get_socket(rec_u->conn); + u3_hcon* hon_u = (u3_hcon*)suv_u->han_u; + + // sanity check + c3_assert( hon_u->sok_u == &suv_u->sok_u ); + + u3_hreq* req_u = _http_req_new(hon_u, rec_u); + + req_u->tim_u = c3_malloc(sizeof(*req_u->tim_u)); + req_u->tim_u->data = req_u; + uv_timer_init(u3L, req_u->tim_u); + uv_timer_start(req_u->tim_u, _http_req_timer_cb, 900 * 1000, 0); + + _http_req_dispatch(req_u, req); + } + + return 0; +} + +/* _http_conn_find(): find http connection in server by sequence. +*/ +static u3_hcon* +_http_conn_find(u3_http *htp_u, c3_w coq_l) +{ + u3_hcon* hon_u = htp_u->hon_u; + + // XX glories of linear search + // + while ( hon_u ) { + if ( coq_l == hon_u->coq_l ) { + return hon_u; + } + hon_u = hon_u->nex_u; + } + return 0; +} + +/* _http_conn_link(): link http request to connection +*/ +static void +_http_conn_link(u3_http* htp_u, u3_hcon* hon_u) +{ + hon_u->htp_u = htp_u; + hon_u->coq_l = htp_u->coq_l++; + hon_u->nex_u = htp_u->hon_u; + + if ( 0 != hon_u->nex_u ) { + hon_u->nex_u->pre_u = hon_u; + } + htp_u->hon_u = hon_u; +} + +/* _http_conn_unlink(): remove http request from connection +*/ +static void +_http_conn_unlink(u3_hcon* hon_u) +{ + if ( 0 != hon_u->pre_u ) { + hon_u->pre_u->nex_u = hon_u->nex_u; + + if ( 0 != hon_u->nex_u ) { + hon_u->nex_u->pre_u = hon_u->pre_u; + } + } + else { + hon_u->htp_u->hon_u = hon_u->nex_u; + + if ( 0 != hon_u->nex_u ) { + hon_u->nex_u->pre_u = 0; + } + } +} + +/* _http_conn_free(): free http connection on close. +*/ +static void +_http_conn_free(uv_handle_t* han_t) +{ + u3_hcon* hon_u = (u3_hcon*)han_t; + u3_http* htp_u = hon_u->htp_u; + u3_h2o_serv* h2o_u = htp_u->h2o_u; + + c3_assert( 0 == hon_u->req_u ); + +#if 0 + { + c3_w len_w = 0; + + u3_hcon* noh_u = htp_u->hon_u; + + while ( 0 != noh_u ) { + len_w++; + noh_u = noh_u->nex_u; + } + + u3l_log("http conn free %d of %u server %d\n", hon_u->coq_l, len_w, htp_u->sev_l); + } +#endif + + _http_conn_unlink(hon_u); + +#if 0 + { + c3_w len_w = 0; + + u3_hcon* noh_u = htp_u->hon_u; + + while ( 0 != noh_u ) { + len_w++; + noh_u = noh_u->nex_u; + } + + u3l_log("http conn free %u remaining\n", len_w); + } +#endif + + if ( (0 == htp_u->hon_u) && (0 != h2o_u->ctx_u.shutdown_requested) ) { +#if 0 + u3l_log("http conn free %d free server %d\n", hon_u->coq_l, htp_u->sev_l); +#endif + _http_serv_free(htp_u); + } + + free(hon_u); +} + +/* _http_conn_new(): create and accept http connection. +*/ +static u3_hcon* +_http_conn_new(u3_http* htp_u) +{ + u3_hcon* hon_u = c3_malloc(sizeof(*hon_u)); + hon_u->seq_l = 1; + hon_u->ipf_w = 0; + hon_u->req_u = 0; + hon_u->sok_u = 0; + hon_u->con_u = 0; + hon_u->pre_u = 0; + + _http_conn_link(htp_u, hon_u); + +#if 0 + u3l_log("http conn neww %d server %d\n", hon_u->coq_l, htp_u->sev_l); +#endif + + return hon_u; +} + +/* _http_serv_find(): find http server by sequence. +*/ +static u3_http* +_http_serv_find(c3_l sev_l) +{ + u3_http* htp_u = u3_Host.htp_u; + + // XX glories of linear search + // + while ( htp_u ) { + if ( sev_l == htp_u->sev_l ) { + return htp_u; + } + htp_u = htp_u->nex_u; + } + return 0; +} + +/* _http_serv_link(): link http server to global state. +*/ +static void +_http_serv_link(u3_http* htp_u) +{ + // XX link elsewhere initially, relink on start? + + if ( 0 != u3_Host.htp_u ) { + htp_u->sev_l = 1 + u3_Host.htp_u->sev_l; + } + else { + htp_u->sev_l = u3A->sev_l; + } + + htp_u->nex_u = u3_Host.htp_u; + u3_Host.htp_u = htp_u; +} + +/* _http_serv_unlink(): remove http server from global state. +*/ +static void +_http_serv_unlink(u3_http* htp_u) +{ + // XX link elsewhere initially, relink on start? + + if ( u3_Host.htp_u == htp_u ) { + u3_Host.htp_u = htp_u->nex_u; + } + else { + u3_http* pre_u = u3_Host.htp_u; + + // XX glories of linear search + // + while ( pre_u ) { + if ( pre_u->nex_u == htp_u ) { + pre_u->nex_u = htp_u->nex_u; + } + else pre_u = pre_u->nex_u; + } + } +} + +/* _http_h2o_context_dispose(): h2o_context_dispose, inlined and cleaned up. +*/ +static void +_http_h2o_context_dispose(h2o_context_t* ctx) +{ + h2o_globalconf_t *config = ctx->globalconf; + size_t i, j; + + for (i = 0; config->hosts[i] != NULL; ++i) { + h2o_hostconf_t *hostconf = config->hosts[i]; + for (j = 0; j != hostconf->paths.size; ++j) { + h2o_pathconf_t *pathconf = hostconf->paths.entries + j; + h2o_context_dispose_pathconf_context(ctx, pathconf); + } + h2o_context_dispose_pathconf_context(ctx, &hostconf->fallback_path); + } + + free(ctx->_pathconfs_inited.entries); + free(ctx->_module_configs); + + h2o_timeout_dispose(ctx->loop, &ctx->zero_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->hundred_ms_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->handshake_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->http1.req_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->http2.idle_timeout); + + // NOTE: linked in http2/connection, never unlinked + h2o_timeout_unlink(&ctx->http2._graceful_shutdown_timeout); + + h2o_timeout_dispose(ctx->loop, &ctx->http2.graceful_shutdown_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->proxy.io_timeout); + h2o_timeout_dispose(ctx->loop, &ctx->one_sec_timeout); + + h2o_filecache_destroy(ctx->filecache); + ctx->filecache = NULL; + + /* clear storage */ + for (i = 0; i != ctx->storage.size; ++i) { + h2o_context_storage_item_t *item = ctx->storage.entries + i; + if (item->dispose != NULL) { + item->dispose(item->data); + } + } + + free(ctx->storage.entries); + + h2o_multithread_unregister_receiver(ctx->queue, &ctx->receivers.hostinfo_getaddr); + h2o_multithread_destroy_queue(ctx->queue); + + if (ctx->_timestamp_cache.value != NULL) { + h2o_mem_release_shared(ctx->_timestamp_cache.value); + } + + // NOTE: explicit uv_run removed +} + +/* _http_serv_really_free(): free http server. +*/ +static void +_http_serv_really_free(u3_http* htp_u) +{ + c3_assert( 0 == htp_u->hon_u ); + + if ( 0 != htp_u->h2o_u ) { + u3_h2o_serv* h2o_u = htp_u->h2o_u; + + if ( 0 != h2o_u->cep_u.ssl_ctx ) { + SSL_CTX_free(h2o_u->cep_u.ssl_ctx); + } + + h2o_config_dispose(&h2o_u->fig_u); + + // XX h2o_cleanup_thread if not restarting? + + free(htp_u->h2o_u); + htp_u->h2o_u = 0; + } + + _http_serv_unlink(htp_u); + free(htp_u); +} + +/* http_serv_free_cb(): timer callback for freeing http server. +*/ +static void +http_serv_free_cb(uv_timer_t* tim_u) +{ + u3_http* htp_u = tim_u->data; + + _http_serv_really_free(htp_u); + + uv_close((uv_handle_t*)tim_u, (uv_close_cb)free); +} + +/* _http_serv_free(): begin to free http server. +*/ +static void +_http_serv_free(u3_http* htp_u) +{ +#if 0 + u3l_log("http serv free %d\n", htp_u->sev_l); +#endif + + c3_assert( 0 == htp_u->hon_u ); + + if ( 0 == htp_u->h2o_u ) { + _http_serv_really_free(htp_u); + } + else { + u3_h2o_serv* h2o_u = htp_u->h2o_u; + + _http_h2o_context_dispose(&h2o_u->ctx_u); + + // NOTE: free deferred to allow timers to be closed + // this is a heavy-handed workaround for the lack of + // close callbacks in h2o_timer_t + // it's unpredictable how many event-loop turns will + // be required to finish closing the underlying uv_timer_t + // and we can't free until that's done (or we have UB) + // testing reveals 5s to be a long enough deferral + uv_timer_t* tim_u = c3_malloc(sizeof(*tim_u)); + + tim_u->data = htp_u; + + uv_timer_init(u3L, tim_u); + uv_timer_start(tim_u, http_serv_free_cb, 5000, 0); + } +} + +/* _http_serv_close_cb(): http server uv_close callback. +*/ +static void +_http_serv_close_cb(uv_handle_t* han_u) +{ + u3_http* htp_u = (u3_http*)han_u; + htp_u->liv = c3n; + + // otherwise freed by the last linked connection + if ( 0 == htp_u->hon_u ) { + _http_serv_free(htp_u); + } + + // restart if all linked servers have been shutdown + { + htp_u = u3_Host.htp_u; + c3_o res = c3y; + + while ( 0 != htp_u ) { + if ( c3y == htp_u->liv ) { + res = c3n; + } + htp_u = htp_u->nex_u; + } + + if ( (c3y == res) && (0 != u3_Host.fig_u.for_u) ) { + _http_serv_start_all(); + } + } +} + +/* _http_serv_close(): close http server gracefully. +*/ +static void +_http_serv_close(u3_http* htp_u) +{ + u3_h2o_serv* h2o_u = htp_u->h2o_u; + h2o_context_request_shutdown(&h2o_u->ctx_u); + +#if 0 + u3l_log("http serv close %d %p\n", htp_u->sev_l, &htp_u->wax_u); +#endif + + uv_close((uv_handle_t*)&htp_u->wax_u, _http_serv_close_cb); + + if ( 0 != htp_u->rox_u ) { + // XX close soft + _proxy_serv_close(htp_u->rox_u); + htp_u->rox_u = 0; + } +} + +/* _http_serv_new(): create new http server. +*/ +static u3_http* +_http_serv_new(c3_s por_s, c3_o sec, c3_o lop) +{ + u3_http* htp_u = c3_malloc(sizeof(*htp_u)); + + htp_u->coq_l = 1; + htp_u->por_s = por_s; + htp_u->sec = sec; + htp_u->lop = lop; + htp_u->liv = c3y; + htp_u->h2o_u = 0; + htp_u->rox_u = 0; + htp_u->hon_u = 0; + htp_u->nex_u = 0; + + _http_serv_link(htp_u); + + return htp_u; +} + +/* _http_serv_accept(): accept new http connection. +*/ +static void +_http_serv_accept(u3_http* htp_u) +{ + u3_hcon* hon_u = _http_conn_new(htp_u); + + uv_tcp_init(u3L, &hon_u->wax_u); + + c3_i sas_i; + + if ( 0 != (sas_i = uv_accept((uv_stream_t*)&htp_u->wax_u, + (uv_stream_t*)&hon_u->wax_u)) ) { + if ( (u3C.wag_w & u3o_verbose) ) { + u3l_log("http: accept: %s\n", uv_strerror(sas_i)); + } + + uv_close((uv_handle_t*)&hon_u->wax_u, _http_conn_free); + return; + } + + hon_u->sok_u = h2o_uv_socket_create((uv_stream_t*)&hon_u->wax_u, + _http_conn_free); + + h2o_accept(&((u3_h2o_serv*)htp_u->h2o_u)->cep_u, hon_u->sok_u); + + // capture h2o connection (XX fragile) + hon_u->con_u = (h2o_conn_t*)hon_u->sok_u->data; + + struct sockaddr_in adr_u; + h2o_socket_getpeername(hon_u->sok_u, (struct sockaddr*)&adr_u); + hon_u->ipf_w = ( adr_u.sin_family != AF_INET ) ? + 0 : ntohl(adr_u.sin_addr.s_addr); +} + +/* _http_serv_listen_cb(): uv_connection_cb for uv_listen +*/ +static void +_http_serv_listen_cb(uv_stream_t* str_u, c3_i sas_i) +{ + u3_http* htp_u = (u3_http*)str_u; + + if ( 0 != sas_i ) { + u3l_log("http: listen_cb: %s\n", uv_strerror(sas_i)); + } + else { + _http_serv_accept(htp_u); + } +} + +/* _http_serv_init_h2o(): initialize h2o ctx and handlers for server. +*/ +static u3_h2o_serv* +_http_serv_init_h2o(SSL_CTX* tls_u, c3_o log, c3_o red) +{ + u3_h2o_serv* h2o_u = c3_calloc(sizeof(*h2o_u)); + + h2o_config_init(&h2o_u->fig_u); + h2o_u->fig_u.server_name = h2o_iovec_init( + H2O_STRLIT("urbit/vere-" URBIT_VERSION)); + + // XX default pending vhost/custom-domain design + // XX revisit the effect of specifying the port + h2o_u->hos_u = h2o_config_register_host(&h2o_u->fig_u, + h2o_iovec_init(H2O_STRLIT("default")), + 65535); + + h2o_u->cep_u.ctx = (h2o_context_t*)&h2o_u->ctx_u; + h2o_u->cep_u.hosts = h2o_u->fig_u.hosts; + h2o_u->cep_u.ssl_ctx = tls_u; + + h2o_u->han_u = h2o_create_handler(&h2o_u->hos_u->fallback_path, + sizeof(*h2o_u->han_u)); + if ( c3y == red ) { + // XX h2o_redirect_register + h2o_u->han_u->on_req = _http_rec_accept; + } + else { + h2o_u->han_u->on_req = _http_rec_accept; + } + + if ( c3y == log ) { + // XX move this to post serv_start and put the port in the name +#if 0 + c3_c* pax_c = u3_Host.dir_c; + u3_noun now = u3dc("scot", c3__da, u3k(u3A->now)); + c3_c* now_c = u3r_string(now); + c3_c* nam_c = ".access.log"; + c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(now_c) + strlen(nam_c); + + c3_c* paf_c = c3_malloc(len_w); + snprintf(paf_c, len_w, "%s/%s%s", pax_c, now_c, nam_c); + + h2o_access_log_filehandle_t* fil_u = + h2o_access_log_open_handle(paf_c, 0, H2O_LOGCONF_ESCAPE_APACHE); + + h2o_access_log_register(&h2o_u->hos_u->fallback_path, fil_u); + + free(paf_c); + free(now_c); + u3z(now); +#endif + } + + // XX h2o_compress_register + + h2o_context_init(&h2o_u->ctx_u, u3L, &h2o_u->fig_u); + + return h2o_u; +} + +/* _http_serv_start(): start http server. +*/ +static void +_http_serv_start(u3_http* htp_u) +{ + struct sockaddr_in adr_u; + memset(&adr_u, 0, sizeof(adr_u)); + + adr_u.sin_family = AF_INET; + adr_u.sin_addr.s_addr = ( c3y == htp_u->lop ) ? + htonl(INADDR_LOOPBACK) : + INADDR_ANY; + + uv_tcp_init(u3L, &htp_u->wax_u); + + /* Try ascending ports. + */ + while ( 1 ) { + c3_i sas_i; + + adr_u.sin_port = htons(htp_u->por_s); + + if ( 0 != (sas_i = uv_tcp_bind(&htp_u->wax_u, + (const struct sockaddr*)&adr_u, 0)) || + 0 != (sas_i = uv_listen((uv_stream_t*)&htp_u->wax_u, + TCP_BACKLOG, _http_serv_listen_cb)) ) { + if ( (UV_EADDRINUSE == sas_i) || (UV_EACCES == sas_i) ) { + if ( (c3y == htp_u->sec) && (443 == htp_u->por_s) ) { + htp_u->por_s = 8443; + } + else if ( (c3n == htp_u->sec) && (80 == htp_u->por_s) ) { + htp_u->por_s = 8080; + } + else { + htp_u->por_s++; + } + + continue; + } + + u3l_log("http: listen: %s\n", uv_strerror(sas_i)); + + if ( 0 != htp_u->rox_u ) { + _proxy_serv_free(htp_u->rox_u); + } + _http_serv_free(htp_u); + return; + } + + // XX this is weird + if ( 0 != htp_u->rox_u ) { + htp_u->rox_u = _proxy_serv_start(htp_u->rox_u); + } + + if ( 0 != htp_u->rox_u ) { + u3l_log("http: live (%s, %s) on %d (proxied on %d)\n", + (c3y == htp_u->sec) ? "secure" : "insecure", + (c3y == htp_u->lop) ? "loopback" : "public", + htp_u->por_s, + htp_u->rox_u->por_s); + } + else { + u3l_log("http: live (%s, %s) on %d\n", + (c3y == htp_u->sec) ? "secure" : "insecure", + (c3y == htp_u->lop) ? "loopback" : "public", + htp_u->por_s); + } + + break; + } +} + +//XX deduplicate these with cttp + +/* _cttp_mcut_char(): measure/cut character. +*/ +static c3_w +_cttp_mcut_char(c3_c* buf_c, c3_w len_w, c3_c chr_c) +{ + if ( buf_c ) { + buf_c[len_w] = chr_c; + } + return len_w + 1; +} + +/* _cttp_mcut_cord(): measure/cut cord. +*/ +static c3_w +_cttp_mcut_cord(c3_c* buf_c, c3_w len_w, u3_noun san) +{ + c3_w ten_w = u3r_met(3, san); + + if ( buf_c ) { + u3r_bytes(0, ten_w, (c3_y *)(buf_c + len_w), san); + } + u3z(san); + return (len_w + ten_w); +} + +/* _cttp_mcut_path(): measure/cut cord list. +*/ +static c3_w +_cttp_mcut_path(c3_c* buf_c, c3_w len_w, c3_c sep_c, u3_noun pax) +{ + u3_noun axp = pax; + + while ( u3_nul != axp ) { + u3_noun h_axp = u3h(axp); + + len_w = _cttp_mcut_cord(buf_c, len_w, u3k(h_axp)); + axp = u3t(axp); + + if ( u3_nul != axp ) { + len_w = _cttp_mcut_char(buf_c, len_w, sep_c); + } + } + u3z(pax); + return len_w; +} + +static uv_buf_t +_http_wain_to_buf(u3_noun wan) +{ + c3_w len_w = _cttp_mcut_path(0, 0, (c3_c)10, u3k(wan)); + c3_c* buf_c = c3_malloc(1 + len_w); + + _cttp_mcut_path(buf_c, 0, (c3_c)10, wan); + buf_c[len_w] = 0; + + return uv_buf_init(buf_c, len_w); +} + +/* _http_init_tls: initialize OpenSSL context +*/ +static SSL_CTX* +_http_init_tls(uv_buf_t key_u, uv_buf_t cer_u) +{ + // XX require 1.1.0 and use TLS_server_method() + SSL_CTX* tls_u = SSL_CTX_new(SSLv23_server_method()); + // XX use SSL_CTX_set_max_proto_version() and SSL_CTX_set_min_proto_version() + SSL_CTX_set_options(tls_u, SSL_OP_NO_SSLv2 | + SSL_OP_NO_SSLv3 | + // SSL_OP_NO_TLSv1 | // XX test + SSL_OP_NO_COMPRESSION); + + SSL_CTX_set_default_verify_paths(tls_u); + SSL_CTX_set_session_cache_mode(tls_u, SSL_SESS_CACHE_OFF); + SSL_CTX_set_cipher_list(tls_u, + "ECDH+AESGCM:DH+AESGCM:ECDH+AES256:DH+AES256:" + "ECDH+AES128:DH+AES:ECDH+3DES:DH+3DES:RSA+AESGCM:" + "RSA+AES:RSA+3DES:!aNULL:!MD5:!DSS"); + + // enable ALPN for HTTP 2 support +#if H2O_USE_ALPN + { + SSL_CTX_set_ecdh_auto(tls_u, 1); + h2o_ssl_register_alpn_protocols(tls_u, h2o_http2_alpn_protocols); + } +#endif + + { + BIO* bio_u = BIO_new_mem_buf(key_u.base, key_u.len); + EVP_PKEY* pky_u = PEM_read_bio_PrivateKey(bio_u, 0, 0, 0); + c3_i sas_i = SSL_CTX_use_PrivateKey(tls_u, pky_u); + + EVP_PKEY_free(pky_u); + BIO_free(bio_u); + + if( 0 == sas_i ) { + u3l_log("http: load private key failed:\n"); + ERR_print_errors_fp(u3_term_io_hija()); + u3_term_io_loja(1); + + SSL_CTX_free(tls_u); + + return 0; + } + } + + { + BIO* bio_u = BIO_new_mem_buf(cer_u.base, cer_u.len); + X509* xer_u = PEM_read_bio_X509_AUX(bio_u, 0, 0, 0); + c3_i sas_i = SSL_CTX_use_certificate(tls_u, xer_u); + + X509_free(xer_u); + + if( 0 == sas_i ) { + u3l_log("http: load certificate failed:\n"); + ERR_print_errors_fp(u3_term_io_hija()); + u3_term_io_loja(1); + + BIO_free(bio_u); + SSL_CTX_free(tls_u); + + return 0; + } + + // get any additional CA certs, ignoring errors + while ( 0 != (xer_u = PEM_read_bio_X509(bio_u, 0, 0, 0)) ) { + // XX require 1.0.2 or newer and use SSL_CTX_add0_chain_cert + SSL_CTX_add_extra_chain_cert(tls_u, xer_u); + } + + BIO_free(bio_u); + } + + return tls_u; +} + +/* _http_write_ports_file(): update .http.ports +*/ +static void +_http_write_ports_file(c3_c *pax_c) +{ + c3_c* nam_c = ".http.ports"; + c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(nam_c); + + c3_c* paf_c = c3_malloc(len_w); + snprintf(paf_c, len_w, "%s/%s", pax_c, nam_c); + + c3_i por_i = open(paf_c, O_WRONLY | O_CREAT | O_TRUNC, 0666); + free(paf_c); + + u3_http* htp_u = u3_Host.htp_u; + + while ( 0 != htp_u ) { + // XX write proxy ports instead? + if ( 0 < htp_u->por_s ) { + dprintf(por_i, "%u %s %s\n", htp_u->por_s, + (c3y == htp_u->sec) ? "secure" : "insecure", + (c3y == htp_u->lop) ? "loopback" : "public"); + } + + htp_u = htp_u->nex_u; + } + + c3_sync(por_i); + close(por_i); +} + +/* _http_release_ports_file(): remove .http.ports +*/ +static void +_http_release_ports_file(c3_c *pax_c) +{ + c3_c* nam_c = ".http.ports"; + c3_w len_w = 1 + strlen(pax_c) + 1 + strlen(nam_c); + + c3_c* paf_c = c3_malloc(len_w); + snprintf(paf_c, len_w, "%s/%s", pax_c, nam_c); + + unlink(paf_c); + free(paf_c); +} + + +/* _http_czar_host(): galaxy hostname as (unit host:eyre) +*/ +static u3_noun +_http_czar_host(void) +{ + u3_noun dom = u3_nul; + return dom; + + // XX revisit +#if 0 + if ( (0 == u3_Host.ops_u.imp_c) || (c3n == u3_Host.ops_u.net) ) { + return dom; + } + + { + c3_c* dns_c = u3_Host.ops_u.dns_c; + c3_w len_w = strlen(dns_c); + c3_w dif_w; + c3_c* dom_c; + c3_c* dot_c; + + while ( 0 != len_w ) { + if ( 0 == (dot_c = strchr(dns_c, '.'))) { + len_w = 0; + dom = u3nc(u3i_string(dns_c), dom); + break; + } + else { + dif_w = dot_c - dns_c; + dom_c = c3_malloc(1 + dif_w); + strncpy(dom_c, dns_c, dif_w); + dom_c[dif_w] = 0; + + dom = u3nc(u3i_string(dom_c), dom); + + // increment to skip leading '.' + dns_c = dot_c + 1; + free(dom_c); + + // XX confirm that underflow is impossible here + len_w -= c3_min(dif_w, len_w); + } + } + } + + if ( u3_nul == dom ) { + return dom; + } + + // increment to skip '~' + dom = u3nc(u3i_string(u3_Host.ops_u.imp_c + 1), u3kb_flop(u3k(dom))); + + return u3nt(u3_nul, c3y, u3kb_flop(u3k(dom))); +#endif +} + +/* u3_http_ef_bake(): notify %eyre that we're live +*/ +void +u3_http_ef_bake(void) +{ + u3_noun ipf = u3_nul; + + { + struct ifaddrs* iad_u; + getifaddrs(&iad_u); + + struct ifaddrs* dia_u = iad_u; + + while ( iad_u ) { + struct sockaddr_in* adr_u = (struct sockaddr_in *)iad_u->ifa_addr; + + if ( (0 != adr_u) && (AF_INET == adr_u->sin_family) ) { + c3_w ipf_w = ntohl(adr_u->sin_addr.s_addr); + + if ( INADDR_LOOPBACK != ipf_w ) { + ipf = u3nc(u3nc(c3n, u3i_words(1, &ipf_w)), ipf); + } + } + + iad_u = iad_u->ifa_next; + } + + freeifaddrs(dia_u); + } + + u3_noun hot = _http_czar_host(); + + if ( u3_nul != hot ) { + ipf = u3nc(u3k(u3t(hot)), ipf); + u3z(hot); + } + + u3_noun pax = u3nq(u3_blip, c3__http, u3k(u3A->sen), u3_nul); + + u3_pier_plan(pax, u3nc(c3__born, ipf)); +} + +/* u3_http_ef_thou(): send %thou from %eyre as http response. +*/ +void +u3_http_ef_thou(c3_l sev_l, + c3_l coq_l, + c3_l seq_l, + u3_noun rep) +{ + u3_http* htp_u; + u3_hcon* hon_u; + u3_hreq* req_u; + c3_w bug_w = u3C.wag_w & u3o_verbose; + + if ( !(htp_u = _http_serv_find(sev_l)) ) { + if ( bug_w ) { + u3l_log("http: server not found: %x\r\n", sev_l); + } + } + else if ( !(hon_u = _http_conn_find(htp_u, coq_l)) ) { + if ( bug_w ) { + u3l_log("http: connection not found: %x/%d\r\n", sev_l, coq_l); + } + } + else if ( !(req_u = _http_req_find(hon_u, seq_l)) ) { + if ( bug_w ) { + u3l_log("http: request not found: %x/%d/%d\r\n", + sev_l, coq_l, seq_l); + } + } + else { + u3_noun p_rep, q_rep, r_rep; + + if ( c3n == u3r_trel(rep, &p_rep, &q_rep, &r_rep) ) { + u3l_log("http: strange response\n"); + } + else { + _http_req_respond(req_u, u3k(p_rep), u3k(q_rep), u3k(r_rep)); + } + } + + u3z(rep); +} + +/* _http_serv_start_all(): initialize and start servers based on saved config. +*/ +static void +_http_serv_start_all(void) +{ + u3_http* htp_u; + c3_s por_s; + + u3_noun sec = u3_nul; + u3_noun non = u3_none; + + u3_form* for_u = u3_Host.fig_u.for_u; + + c3_assert( 0 != for_u ); + + // if the SSL_CTX existed, it'll be freed with the servers + u3_Host.tls_u = 0; + + // HTTPS server. + if ( (0 != for_u->key_u.base) && (0 != for_u->cer_u.base) ) { + u3_Host.tls_u = _http_init_tls(for_u->key_u, for_u->cer_u); + + // Note: if tls_u is used for additional servers, + // its reference count must be incremented with SSL_CTX_up_ref + + if ( 0 != u3_Host.tls_u ) { + por_s = ( c3y == for_u->pro ) ? 8443 : 443; + htp_u = _http_serv_new(por_s, c3y, c3n); + htp_u->h2o_u = _http_serv_init_h2o(u3_Host.tls_u, for_u->log, for_u->red); + + if ( c3y == for_u->pro ) { + htp_u->rox_u = _proxy_serv_new(htp_u, 443, c3y); + } + + _http_serv_start(htp_u); + sec = u3nc(u3_nul, htp_u->por_s); + } + } + + // HTTP server. + { + por_s = ( c3y == for_u->pro ) ? 8080 : 80; + htp_u = _http_serv_new(por_s, c3n, c3n); + htp_u->h2o_u = _http_serv_init_h2o(0, for_u->log, for_u->red); + + if ( c3y == for_u->pro ) { + htp_u->rox_u = _proxy_serv_new(htp_u, 80, c3n); + } + + _http_serv_start(htp_u); + non = htp_u->por_s; + } + + // Loopback server. + { + por_s = 12321; + htp_u = _http_serv_new(por_s, c3n, c3y); + htp_u->h2o_u = _http_serv_init_h2o(0, for_u->log, for_u->red); + // never proxied + + _http_serv_start(htp_u); + } + + // send listening ports to %eyre + { + c3_assert( u3_none != non ); + + u3_noun pax = u3nq(u3_blip, c3__http, u3k(u3A->sen), u3_nul); + u3_pier_plan(pax, u3nt(c3__live, non, sec)); + } + + _http_write_ports_file(u3_Host.dir_c); + _http_form_free(); +} + +/* _http_serv_restart(): gracefully shutdown, then start servers. +*/ +static void +_http_serv_restart(void) +{ + u3_http* htp_u = u3_Host.htp_u; + + if ( 0 == htp_u ) { + _http_serv_start_all(); + } + else { + u3l_log("http: restarting servers to apply configuration\n"); + + while ( 0 != htp_u ) { + if ( c3y == htp_u->liv ) { + _http_serv_close(htp_u); + } + htp_u = htp_u->nex_u; + } + + _http_release_ports_file(u3_Host.dir_c); + } +} + +/* _http_form_free(): free and unlink saved config. +*/ +static void +_http_form_free(void) +{ + u3_form* for_u = u3_Host.fig_u.for_u; + + if ( 0 == for_u ) { + return; + } + + if ( 0 != for_u->key_u.base ) { + free(for_u->key_u.base); + } + + if ( 0 != for_u->cer_u.base ) { + free(for_u->cer_u.base); + } + + free(for_u); + u3_Host.fig_u.for_u = 0; +} + +/* u3_http_ef_form(): apply configuration, restart servers. +*/ +void +u3_http_ef_form(u3_noun fig) +{ + u3_noun sec, pro, log, red; + + if ( (c3n == u3r_qual(fig, &sec, &pro, &log, &red) ) || + // confirm sec is a valid (unit ^) + !( u3_nul == sec || ( c3y == u3du(sec) && + c3y == u3du(u3t(sec)) && + u3_nul == u3h(sec) ) ) || + // confirm valid flags ("loobeans") + !( c3y == pro || c3n == pro ) || + !( c3y == log || c3n == log ) || + !( c3y == red || c3n == red ) ) { + u3l_log("http: form: invalid card\n"); + u3z(fig); + return; + } + + u3_form* for_u = c3_malloc(sizeof(*for_u)); + for_u->pro = (c3_o)pro; + for_u->log = (c3_o)log; + for_u->red = (c3_o)red; + + if ( u3_nul != sec ) { + u3_noun key = u3h(u3t(sec)); + u3_noun cer = u3t(u3t(sec)); + + for_u->key_u = _http_wain_to_buf(u3k(key)); + for_u->cer_u = _http_wain_to_buf(u3k(cer)); + } + else { + for_u->key_u = uv_buf_init(0, 0); + for_u->cer_u = uv_buf_init(0, 0); + } + + u3z(fig); + _http_form_free(); + + u3_Host.fig_u.for_u = for_u; + + _http_serv_restart(); +} + +/* u3_http_io_init(): initialize http I/O. +*/ +void +u3_http_io_init(void) +{ +} + +/* u3_http_io_talk(): start http I/O. +*/ +void +u3_http_io_talk(void) +{ +} + +/* u3_http_io_exit(): shut down http. +*/ +void +u3_http_io_exit(void) +{ + // Note: nothing in this codepath can print to uH! + // it will seriously mess up your terminal + + // u3_http* htp_u; + + // for ( htp_u = u3_Host.htp_u; htp_u; htp_u = htp_u->nex_u ) { + // _http_serv_close_hard(htp_u); + // } + + // XX close u3_Host.fig_u.cli_u and con_u + + _http_release_ports_file(u3_Host.dir_c); +} + +/////////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////////////////////////////////////// + +typedef enum { + u3_pars_good = 0, // success + u3_pars_fail = 1, // failure + u3_pars_moar = 2 // incomplete +} u3_proxy_pars; + +/* _proxy_alloc(): libuv buffer allocator +*/ +static void +_proxy_alloc(uv_handle_t* had_u, + size_t len_i, + uv_buf_t* buf) +{ + // len_i is always 64k, so we're ignoring it + // using fixed size 4K buffer for + // XX consider h2o_buffer_t, a pool, or something XX + void* ptr_v = c3_malloc(4096); + *buf = uv_buf_init(ptr_v, 4096); +} + +/* _proxy_warc_link(): link warc to global state. +*/ +static void +_proxy_warc_link(u3_warc* cli_u) +{ + cli_u->nex_u = u3_Host.fig_u.cli_u; + + if ( 0 != cli_u->nex_u ) { + cli_u->nex_u->pre_u = cli_u; + } + u3_Host.fig_u.cli_u = cli_u; +} + +/* _proxy_warc_unlink(): unlink warc from global state. +*/ +static void +_proxy_warc_unlink(u3_warc* cli_u) +{ + if ( 0 != cli_u->pre_u ) { + cli_u->pre_u->nex_u = cli_u->nex_u; + + if ( 0 != cli_u->nex_u ) { + cli_u->nex_u->pre_u = cli_u->pre_u; + } + } + else { + u3_Host.fig_u.cli_u = cli_u->nex_u; + + if ( 0 != cli_u->nex_u ) { + cli_u->nex_u->pre_u = 0; + } + } +} + +/* _proxy_warc_free(): free ward client +*/ +static void +_proxy_warc_free(u3_warc* cli_u) +{ + _proxy_warc_unlink(cli_u); + free(cli_u->non_u.base); + free(cli_u->hot_c); + free(cli_u); +} + +/* _proxy_warc_new(): allocate ship-specific proxy client +*/ +static u3_warc* +_proxy_warc_new(u3_http* htp_u, u3_atom sip, u3_atom non, c3_s por_s, c3_o sec) +{ + u3_warc* cli_u = c3_calloc(sizeof(*cli_u)); + cli_u->htp_u = htp_u; + cli_u->por_s = por_s; + cli_u->sec = sec; + + u3r_chubs(0, 2, cli_u->who_d, sip); + _proxy_warc_link(cli_u); + + { + c3_w len_w = u3r_met(3, non); + + c3_assert( 256 > len_w ); + + c3_y* non_y = c3_malloc(1 + len_w); + non_y[0] = (c3_y)len_w; + + u3r_bytes(0, len_w, non_y + 1, non); + + cli_u->non_u = uv_buf_init((c3_c*)non_y, 1 + len_w); + } + + u3z(non); + u3z(sip); + + return cli_u; +} + +/* _proxy_conn_link(): link con to listener or global state. +*/ +static void +_proxy_conn_link(u3_pcon* con_u) +{ + switch ( con_u->typ_e ) { + default: c3_assert(0); + + case u3_ptyp_ward: { + con_u->nex_u = u3_Host.fig_u.con_u; + + if ( 0 != con_u->nex_u ) { + con_u->nex_u->pre_u = con_u; + } + u3_Host.fig_u.con_u = con_u; + break; + } + + case u3_ptyp_prox: { + u3_prox* lis_u = con_u->src_u.lis_u; + con_u->nex_u = lis_u->con_u; + + if ( 0 != con_u->nex_u ) { + con_u->nex_u->pre_u = con_u; + } + lis_u->con_u = con_u; + break; + } + } +} + +/* _proxy_conn_unlink(): unlink con from listener or global state. +*/ +static void +_proxy_conn_unlink(u3_pcon* con_u) +{ + if ( 0 != con_u->pre_u ) { + con_u->pre_u->nex_u = con_u->nex_u; + + if ( 0 != con_u->nex_u ) { + con_u->nex_u->pre_u = con_u->pre_u; + } + } + else { + switch ( con_u->typ_e ) { + default: c3_assert(0); + + case u3_ptyp_ward: { + u3_Host.fig_u.con_u = con_u->nex_u; + + if ( 0 != con_u->nex_u ) { + con_u->nex_u->pre_u = 0; + } + break; + } + + case u3_ptyp_prox: { + u3_prox* lis_u = con_u->src_u.lis_u; + lis_u->con_u = con_u->nex_u; + + if ( 0 != con_u->nex_u ) { + con_u->nex_u->pre_u = 0; + } + break; + } + } + } +} + +/* _proxy_conn_free(): free proxy connection +*/ +static void +_proxy_conn_free(uv_handle_t* han_u) +{ + u3_pcon* con_u = han_u->data; + + if ( 0 != con_u->buf_u.base ) { + free(con_u->buf_u.base); + } + + if ( u3_ptyp_ward == con_u->typ_e ) { + _proxy_warc_free(con_u->src_u.cli_u); + } + + _proxy_conn_unlink(con_u); + + free(con_u); +} + +/* _proxy_conn_close(): close both sides of proxy connection +*/ +static void +_proxy_conn_close(u3_pcon* con_u) +{ + // XX revisit, this is called twice when con_u + // is a loopback connection and we're restarting + if ( uv_is_closing((uv_handle_t*)&con_u->don_u) ){ + return; + } + + if ( 0 != con_u->upt_u ) { + uv_close((uv_handle_t*)con_u->upt_u, (uv_close_cb)free); + } + + uv_close((uv_handle_t*)&con_u->don_u, _proxy_conn_free); +} + +/* _proxy_conn_new(): allocate proxy connection +*/ +static u3_pcon* +_proxy_conn_new(u3_proxy_type typ_e, void* src_u) +{ + u3_pcon* con_u = c3_malloc(sizeof(*con_u)); + con_u->upt_u = 0; + con_u->buf_u = uv_buf_init(0, 0); + con_u->nex_u = 0; + con_u->pre_u = 0; + + switch ( typ_e ) { + default: c3_assert(0); + + case u3_ptyp_prox: { + u3_prox* lis_u = (u3_prox*)src_u; + con_u->typ_e = typ_e; + con_u->src_u.lis_u = lis_u; + con_u->sec = lis_u->sec; + break; + } + + case u3_ptyp_ward: { + u3_warc* cli_u = (u3_warc*)src_u; + con_u->typ_e = typ_e; + con_u->src_u.cli_u = cli_u; + con_u->sec = cli_u->sec; + break; + } + } + + con_u->don_u.data = con_u; + + _proxy_conn_link(con_u); + + return con_u; +} + +typedef struct _proxy_write_ctx { + u3_pcon* con_u; + uv_stream_t* str_u; + c3_c* buf_c; +} proxy_write_ctx; + +/* _proxy_write_cb(): free uv_write_t and linked buffer. +*/ +static void +_proxy_write_cb(uv_write_t* wri_u, c3_i sas_i) +{ + if ( 0 != sas_i ) { + if ( 0 != wri_u->data ) { + proxy_write_ctx* ctx_u = wri_u->data; + + if ( ctx_u->str_u == (uv_stream_t*)ctx_u->con_u->upt_u ) { + u3l_log("proxy: write upstream: %s\n", uv_strerror(sas_i)); + } + else if ( ctx_u->str_u == (uv_stream_t*)&(ctx_u->con_u->don_u) ) { + u3l_log("proxy: write downstream: %s\n", uv_strerror(sas_i)); + } + else { + u3l_log("proxy: write: %s\n", uv_strerror(sas_i)); + } + } + else { + u3l_log("proxy: write: %s\n", uv_strerror(sas_i)); + } + } + + if ( 0 != wri_u->data ) { + proxy_write_ctx* ctx_u = wri_u->data; + free(ctx_u->buf_c); + free(ctx_u); + } + + free(wri_u); +} + +/* _proxy_write(): write buffer to proxy stream +*/ +static c3_i +_proxy_write(u3_pcon* con_u, uv_stream_t* str_u, uv_buf_t buf_u) +{ + uv_write_t* wri_u = c3_malloc(sizeof(*wri_u)); + + proxy_write_ctx* ctx_u = c3_malloc(sizeof(*ctx_u)); + ctx_u->con_u = con_u; + ctx_u->str_u = str_u; + ctx_u->buf_c = buf_u.base; + wri_u->data = ctx_u; + + c3_i sas_i; + if ( 0 != (sas_i = uv_write(wri_u, str_u, &buf_u, 1, _proxy_write_cb)) ) { + _proxy_conn_close(con_u); + _proxy_write_cb(wri_u, sas_i); + } + + return sas_i; +} + +/* _proxy_read_downstream_cb(): read from downstream, write upstream. +*/ +static void +_proxy_read_downstream_cb(uv_stream_t* don_u, + ssize_t siz_w, + const uv_buf_t* buf_u) +{ + u3_pcon* con_u = don_u->data; + + if ( 0 > siz_w ) { + if ( UV_EOF != siz_w ) { + u3l_log("proxy: read downstream: %s\n", uv_strerror(siz_w)); + } + _proxy_conn_close(con_u); + } + else { + _proxy_write(con_u, (uv_stream_t*)con_u->upt_u, + uv_buf_init(buf_u->base, siz_w)); + } +} + +/* _proxy_read_upstream_cb(): read from upstream, write downstream. +*/ +static void +_proxy_read_upstream_cb(uv_stream_t* upt_u, + ssize_t siz_w, + const uv_buf_t* buf_u) +{ + u3_pcon* con_u = upt_u->data; + + if ( 0 > siz_w ) { + if ( UV_EOF != siz_w ) { + u3l_log("proxy: read upstream: %s\n", uv_strerror(siz_w)); + } + _proxy_conn_close(con_u); + } + else { + _proxy_write(con_u, (uv_stream_t*)&(con_u->don_u), + uv_buf_init(buf_u->base, siz_w)); + } +} + +/* _proxy_fire(): send pending buffer upstream, setup full duplex. +*/ +static void +_proxy_fire(u3_pcon* con_u) +{ + if ( 0 != con_u->buf_u.base ) { + uv_buf_t fub_u = con_u->buf_u; + con_u->buf_u = uv_buf_init(0, 0); + + if ( 0 != _proxy_write(con_u, (uv_stream_t*)con_u->upt_u, fub_u) ) { + return; + } + } + + // XX set cooldown timers to close these? + + uv_read_start((uv_stream_t*)&con_u->don_u, + _proxy_alloc, _proxy_read_downstream_cb); + + uv_read_start((uv_stream_t*)con_u->upt_u, + _proxy_alloc, _proxy_read_upstream_cb); +} + +/* _proxy_loop_connect_cb(): callback for loopback proxy connect. +*/ +static void +_proxy_loop_connect_cb(uv_connect_t * upc_u, c3_i sas_i) +{ + u3_pcon* con_u = upc_u->data; + + if ( 0 != sas_i ) { + u3l_log("proxy: connect: %s\n", uv_strerror(sas_i)); + _proxy_conn_close(con_u); + } + else { + _proxy_fire(con_u); + } + + free(upc_u); +} + +/* _proxy_loop_connect(): connect to loopback. +*/ +static void +_proxy_loop_connect(u3_pcon* con_u) +{ + uv_tcp_t* upt_u = c3_malloc(sizeof(*upt_u)); + + con_u->upt_u = upt_u; + upt_u->data = con_u; + + uv_tcp_init(u3L, upt_u); + + struct sockaddr_in lop_u; + + memset(&lop_u, 0, sizeof(lop_u)); + lop_u.sin_family = AF_INET; + lop_u.sin_addr.s_addr = htonl(INADDR_LOOPBACK); + + // get the loopback port from the linked server + { + u3_http* htp_u; + + switch ( con_u->typ_e ) { + default: c3_assert(0); + + case u3_ptyp_ward: { + htp_u = con_u->src_u.cli_u->htp_u; + break; + } + + case u3_ptyp_prox: { + htp_u = con_u->src_u.lis_u->htp_u; + break; + } + } + + // XX make unpossible? + c3_assert( (0 != htp_u) && (0 != htp_u->por_s) ); + + lop_u.sin_port = htons(htp_u->por_s); + } + + uv_connect_t* upc_u = c3_malloc(sizeof(*upc_u)); + upc_u->data = con_u; + + c3_i sas_i; + + if ( 0 != (sas_i = uv_tcp_connect(upc_u, upt_u, + (const struct sockaddr*)&lop_u, + _proxy_loop_connect_cb)) ) { + u3l_log("proxy: connect: %s\n", uv_strerror(sas_i)); + free(upc_u); + _proxy_conn_close(con_u); + } +} + +/* _proxy_wcon_link(): link wcon to ward. +*/ +static void +_proxy_wcon_link(u3_wcon* won_u, u3_ward* rev_u) +{ + won_u->nex_u = rev_u->won_u; + rev_u->won_u = won_u; +} + +/* _proxy_wcon_unlink(): unlink wcon from ward. +*/ +static void +_proxy_wcon_unlink(u3_wcon* won_u) +{ + u3_ward* rev_u = won_u->rev_u; + + if ( rev_u->won_u == won_u ) { + rev_u->won_u = won_u->nex_u; + } + else { + u3_wcon* pre_u = rev_u->won_u; + + // XX glories of linear search + // + while ( 0 != pre_u ) { + if ( pre_u->nex_u == won_u ) { + pre_u->nex_u = won_u->nex_u; + } + else pre_u = pre_u->nex_u; + } + } +} + +/* _proxy_wcon_free(): free ward upstream candidate. +*/ +static void +_proxy_wcon_free(uv_handle_t* han_u) +{ + u3_wcon* won_u = han_u->data; + + // Note: not unlinked here, freed concurrent with u3_ward + free(won_u); +} + +/* _proxy_wcon_close(): close ward upstream candidate. +*/ +static void +_proxy_wcon_close(u3_wcon* won_u) +{ + uv_read_stop((uv_stream_t*)&won_u->upt_u); + uv_close((uv_handle_t*)&won_u->upt_u, _proxy_wcon_free); +} + +/* _proxy_wcon_new(): allocate ward upstream candidate. +*/ +static u3_wcon* +_proxy_wcon_new(u3_ward* rev_u) +{ + u3_wcon* won_u = c3_malloc(sizeof(*won_u)); + won_u->upt_u.data = won_u; + won_u->rev_u = rev_u; + won_u->nex_u = 0; + + _proxy_wcon_link(won_u, rev_u); + + return won_u; +} + +/* _proxy_ward_link(): link ward to listener. +*/ +static void +_proxy_ward_link(u3_pcon* con_u, u3_ward* rev_u) +{ + // XX link also to con_u as upstream? + c3_assert( u3_ptyp_prox == con_u->typ_e ); + + u3_prox* lis_u = con_u->src_u.lis_u; + + rev_u->nex_u = lis_u->rev_u; + + if ( 0 != rev_u->nex_u ) { + rev_u->nex_u->pre_u = rev_u; + } + lis_u->rev_u = rev_u; +} + +/* _proxy_ward_unlink(): unlink ward from listener. +*/ +static void +_proxy_ward_unlink(u3_ward* rev_u) +{ + if ( 0 != rev_u->pre_u ) { + rev_u->pre_u->nex_u = rev_u->nex_u; + + if ( 0 != rev_u->nex_u ) { + rev_u->nex_u->pre_u = rev_u->pre_u; + } + } + else { + c3_assert( u3_ptyp_prox == rev_u->con_u->typ_e ); + + u3_prox* lis_u = rev_u->con_u->src_u.lis_u; + lis_u->rev_u = rev_u->nex_u; + + if ( 0 != rev_u->nex_u ) { + rev_u->nex_u->pre_u = 0; + } + } +} + +/* _proxy_ward_free(): free reverse proxy listener +*/ +static void +_proxy_ward_free(uv_handle_t* han_u) +{ + u3_ward* rev_u = han_u->data; + + free(rev_u->non_u.base); + free(rev_u); +} + +/* _proxy_ward_close_timer(): close ward timer +*/ +static void +_proxy_ward_close_timer(uv_handle_t* han_u) +{ + u3_ward* rev_u = han_u->data; + + uv_close((uv_handle_t*)&rev_u->tim_u, _proxy_ward_free); +} + +/* _proxy_ward_close(): close ward (ship-specific listener) +*/ +static void +_proxy_ward_close(u3_ward* rev_u) +{ + _proxy_ward_unlink(rev_u); + + while ( 0 != rev_u->won_u ) { + _proxy_wcon_close(rev_u->won_u); + rev_u->won_u = rev_u->won_u->nex_u; + } + + uv_close((uv_handle_t*)&rev_u->tcp_u, _proxy_ward_close_timer); +} + +/* _proxy_ward_new(): allocate reverse proxy listener +*/ +static u3_ward* +_proxy_ward_new(u3_pcon* con_u, u3_atom sip) +{ + u3_ward* rev_u = c3_calloc(sizeof(*rev_u)); + rev_u->tcp_u.data = rev_u; + rev_u->tim_u.data = rev_u; + rev_u->con_u = con_u; + + u3r_chubs(0, 2, rev_u->who_d, sip); + _proxy_ward_link(con_u, rev_u); + + u3z(sip); + + return rev_u; +} + +/* _proxy_wcon_peek_read_cb(): authenticate connection by checking nonce. +*/ +static void +_proxy_wcon_peek_read_cb(uv_stream_t* upt_u, + ssize_t siz_w, + const uv_buf_t* buf_u) +{ + u3_wcon* won_u = upt_u->data; + u3_ward* rev_u = won_u->rev_u; + + if ( 0 > siz_w ) { + if ( UV_EOF != siz_w ) { + u3l_log("proxy: ward peek: %s\n", uv_strerror(siz_w)); + } + _proxy_wcon_close(won_u); + } + else { + uv_read_stop(upt_u); + + c3_w len_w = rev_u->non_u.len; + + if ( ((len_w + 1) != siz_w) || + (len_w != buf_u->base[0]) || + (0 != memcmp(rev_u->non_u.base, buf_u->base + 1, len_w)) ) { + // u3l_log("proxy: ward auth fail\n"); + _proxy_wcon_unlink(won_u); + _proxy_wcon_close(won_u); + } + else { + _proxy_wcon_unlink(won_u); + + u3_pcon* con_u = rev_u->con_u; + con_u->upt_u = (uv_tcp_t*)&won_u->upt_u; + con_u->upt_u->data = con_u; + + _proxy_fire(con_u); + _proxy_ward_close(rev_u); + } + } +} + +/* _proxy_wcon_peek(): peek at a new incoming connection +*/ +static void +_proxy_wcon_peek(u3_wcon* won_u) +{ + uv_read_start((uv_stream_t*)&won_u->upt_u, + _proxy_alloc, _proxy_wcon_peek_read_cb); +} + +/* _proxy_ward_accept(): accept new connection on ward +*/ +static void +_proxy_ward_accept(u3_ward* rev_u) +{ + u3_wcon* won_u = _proxy_wcon_new(rev_u); + + uv_tcp_init(u3L, &won_u->upt_u); + + c3_i sas_i; + + if ( 0 != (sas_i = uv_accept((uv_stream_t*)&rev_u->tcp_u, + (uv_stream_t*)&won_u->upt_u)) ) { + u3l_log("proxy: accept: %s\n", uv_strerror(sas_i)); + _proxy_wcon_close(won_u); + } + else { + _proxy_wcon_peek(won_u); + } +} + +/* _proxy_ward_listen_cb(): listen callback for ward +*/ +static void +_proxy_ward_listen_cb(uv_stream_t* tcp_u, c3_i sas_i) +{ + u3_ward* rev_u = (u3_ward*)tcp_u; + + if ( 0 != sas_i ) { + u3l_log("proxy: ward: %s\n", uv_strerror(sas_i)); + } + else { + _proxy_ward_accept(rev_u); + } +} + +/* _proxy_ward_timer_cb(): expiration timer for ward +*/ +static void +_proxy_ward_timer_cb(uv_timer_t* tim_u) +{ + u3_ward* rev_u = tim_u->data; + + if ( 0 != rev_u ) { + u3l_log("proxy: ward expired: %d\n", rev_u->por_s); + _proxy_ward_close(rev_u); + _proxy_conn_close(rev_u->con_u); + } +} + +/* _proxy_ward_plan(): notify ship of new ward +*/ +static void +_proxy_ward_plan(u3_ward* rev_u) +{ + u3_noun non; + + { + c3_w* non_w = c3_malloc(64); + c3_w len_w; + + c3_rand(non_w); + + non = u3i_words(16, non_w); + len_w = u3r_met(3, non); + + // the nonce is saved to authenticate u3_wcon + // and will be freed with u3_ward + // + rev_u->non_u = uv_buf_init((c3_c*)non_w, len_w); + } + + // XX confirm duct + u3_noun pax = u3nq(u3_blip, c3__http, c3__prox, + u3nc(u3k(u3A->sen), u3_nul)); + + u3_noun wis = u3nc(c3__wise, u3nq(u3i_chubs(2, rev_u->who_d), + rev_u->por_s, + u3k(rev_u->con_u->sec), + non)); + u3_pier_plan(pax, wis); +} + +/* _proxy_ward_start(): start ward (ship-specific listener). +*/ +static void +_proxy_ward_start(u3_pcon* con_u, u3_noun sip) +{ + u3_ward* rev_u = _proxy_ward_new(con_u, u3k(sip)); + + uv_tcp_init(u3L, &rev_u->tcp_u); + + struct sockaddr_in add_u; + c3_i add_i = sizeof(add_u); + memset(&add_u, 0, add_i); + add_u.sin_family = AF_INET; + add_u.sin_addr.s_addr = INADDR_ANY; + add_u.sin_port = 0; // first available + + c3_i sas_i; + + if ( 0 != (sas_i = uv_tcp_bind(&rev_u->tcp_u, + (const struct sockaddr*)&add_u, 0)) || + 0 != (sas_i = uv_listen((uv_stream_t*)&rev_u->tcp_u, + TCP_BACKLOG, _proxy_ward_listen_cb)) || + 0 != (sas_i = uv_tcp_getsockname(&rev_u->tcp_u, + (struct sockaddr*)&add_u, &add_i))) { + u3l_log("proxy: ward: %s\n", uv_strerror(sas_i)); + _proxy_ward_close(rev_u); + _proxy_conn_close(con_u); + } + else { + rev_u->por_s = ntohs(add_u.sin_port); + +#if 0 + { + u3_noun who = u3dc("scot", 'p', u3k(sip)); + c3_c* who_c = u3r_string(who); + u3l_log("\r\nward for %s started on %u\r\n", who_c, rev_u->por_s); + free(who_c); + u3z(who); + } +#endif + + _proxy_ward_plan(rev_u); + + // XX how long? + // + uv_timer_init(u3L, &rev_u->tim_u); + uv_timer_start(&rev_u->tim_u, _proxy_ward_timer_cb, 300 * 1000, 0); + } + + u3z(sip); +} + +/* _proxy_ward_connect_cb(): ward connection callback +*/ +static void +_proxy_ward_connect_cb(uv_connect_t * upc_u, c3_i sas_i) +{ + u3_pcon* con_u = upc_u->data; + + if ( 0 != sas_i ) { + u3l_log("proxy: ward connect: %s\n", uv_strerror(sas_i)); + _proxy_conn_close(con_u); + } + else { + // XX can con_u close before the loopback conn is established? + _proxy_loop_connect(con_u); + + u3_warc* cli_u = con_u->src_u.cli_u; + + // send %that nonce to ward for authentication + _proxy_write(con_u, (uv_stream_t*)&(con_u->don_u), cli_u->non_u); + + cli_u->non_u = uv_buf_init(0, 0); + } + + free(upc_u); +} + +/* _proxy_ward_connect(): connect to remote ward +*/ +static void +_proxy_ward_connect(u3_warc* cli_u) +{ + u3_pcon* con_u = _proxy_conn_new(u3_ptyp_ward, cli_u); + + uv_tcp_init(u3L, &con_u->don_u); + + struct sockaddr_in add_u; + + memset(&add_u, 0, sizeof(add_u)); + add_u.sin_family = AF_INET; + add_u.sin_addr.s_addr = htonl(cli_u->ipf_w); + add_u.sin_port = htons(cli_u->por_s); + + uv_connect_t* upc_u = c3_malloc(sizeof(*upc_u)); + upc_u->data = con_u; + + c3_i sas_i; + + if ( 0 != (sas_i = uv_tcp_connect(upc_u, &con_u->don_u, + (const struct sockaddr*)&add_u, + _proxy_ward_connect_cb)) ) { + u3l_log("proxy: ward connect: %s\n", uv_strerror(sas_i)); + free(upc_u); + _proxy_conn_close(con_u); + } +} + +/* _proxy_ward_resolve_cb(): ward IP address resolution callback +*/ +static void +_proxy_ward_resolve_cb(uv_getaddrinfo_t* adr_u, + c3_i sas_i, + struct addrinfo* aif_u) +{ + u3_warc* cli_u = adr_u->data; + + if ( 0 != sas_i ) { + u3l_log("proxy: ward: resolve: %s\n", uv_strerror(sas_i)); + _proxy_warc_free(cli_u); + } + else { + // XX traverse struct a la _ames_czar_cb + cli_u->ipf_w = ntohl(((struct sockaddr_in *)aif_u->ai_addr)->sin_addr.s_addr); + _proxy_ward_connect(cli_u); + } + + free(adr_u); + uv_freeaddrinfo(aif_u); +} + +/* _proxy_reverse_resolve(): resolve IP address of remote ward +*/ +static void +_proxy_ward_resolve(u3_warc* cli_u) +{ + uv_getaddrinfo_t* adr_u = c3_malloc(sizeof(*adr_u)); + adr_u->data = cli_u; + + struct addrinfo hin_u; + memset(&hin_u, 0, sizeof(struct addrinfo)); + + hin_u.ai_family = PF_INET; + hin_u.ai_socktype = SOCK_STREAM; + hin_u.ai_protocol = IPPROTO_TCP; + + // XX why the conditional? + // + if ( 0 == cli_u->hot_c ) { + u3_noun sip = u3dc("scot", 'p', u3i_chubs(2, cli_u->who_d)); + c3_c* sip_c = u3r_string(sip); + c3_w len_w = 1 + strlen(sip_c) + strlen(PROXY_DOMAIN); + cli_u->hot_c = c3_malloc(len_w); + // incremented to skip '~' + snprintf(cli_u->hot_c, len_w, "%s.%s", sip_c + 1, PROXY_DOMAIN); + + free(sip_c); + u3z(sip); + } + + c3_i sas_i; + + if ( 0 != (sas_i = uv_getaddrinfo(u3L, adr_u, _proxy_ward_resolve_cb, + cli_u->hot_c, 0, &hin_u)) ) { + u3l_log("proxy: ward: resolve: %s\n", uv_strerror(sas_i)); + _proxy_warc_free(cli_u); + } +} + +/* _proxy_parse_host(): parse plaintext buffer for Host header +*/ +static u3_proxy_pars +_proxy_parse_host(const uv_buf_t* buf_u, c3_c** hot_c) +{ + struct phr_header hed_u[H2O_MAX_HEADERS]; + size_t hed_t = H2O_MAX_HEADERS; + + { + // unused + c3_i ver_i; + const c3_c* met_c; + size_t met_t; + const c3_c* pat_c; + size_t pat_t; + + size_t len_t = buf_u->len < H2O_MAX_REQLEN ? buf_u->len : H2O_MAX_REQLEN; + // XX slowloris? + c3_i las_i = 0; + c3_i sas_i; + + sas_i = phr_parse_request(buf_u->base, len_t, &met_c, &met_t, + &pat_c, &pat_t, &ver_i, hed_u, &hed_t, las_i); + + switch ( sas_i ) { + case -1: return u3_pars_fail; + case -2: return u3_pars_moar; + } + } + + const h2o_token_t* tok_t; + size_t i; + + for ( i = 0; i < hed_t; i++ ) { + // XX in-place, copy first + h2o_strtolower((c3_c*)hed_u[i].name, hed_u[i].name_len); + + if ( 0 != (tok_t = h2o_lookup_token(hed_u[i].name, hed_u[i].name_len)) ) { + if ( tok_t->is_init_header_special && H2O_TOKEN_HOST == tok_t ) { + c3_c* val_c; + c3_c* por_c; + + val_c = c3_malloc(1 + hed_u[i].value_len); + val_c[hed_u[i].value_len] = 0; + memcpy(val_c, hed_u[i].value, hed_u[i].value_len); + + // 'truncate' by replacing port separator ':' with 0 + if ( 0 != (por_c = strchr(val_c, ':')) ) { + por_c[0] = 0; + } + + *hot_c = val_c; + break; + } + } + } + + return u3_pars_good; +} + +/* _proxy_parse_sni(): parse clienthello buffer for SNI +*/ +static u3_proxy_pars +_proxy_parse_sni(const uv_buf_t* buf_u, c3_c** hot_c) +{ + c3_i sas_i = parse_tls_header((const uint8_t*)buf_u->base, + buf_u->len, hot_c); + + if ( 0 > sas_i ) { + switch ( sas_i ) { + case -1: return u3_pars_moar; + case -2: return u3_pars_good; // SNI not present + default: return u3_pars_fail; + } + } + + return u3_pars_good; +} + +/* _proxy_parse_ship(): determine destination (unit ship) for proxied request +*/ +static u3_noun +_proxy_parse_ship(c3_c* hot_c) +{ + if ( 0 == hot_c ) { + return u3_nul; + } + else { + c3_c* dom_c = strchr(hot_c, '.'); + + if ( 0 == dom_c ) { + return u3_nul; + } + else { + // length of the first subdomain + // + c3_w dif_w = dom_c - hot_c; + c3_w dns_w = strlen(PROXY_DOMAIN); + + // validate that everything after the first subdomain + // matches the proxy domain + // (skipped if networking is disabled) + // + if ( (c3y == u3_Host.ops_u.net) && + ( (dns_w != strlen(hot_c) - (dif_w + 1)) || + (0 != strncmp(dom_c + 1, PROXY_DOMAIN, dns_w)) ) ) + { + return u3_nul; + } + else { + // attempt to parse the first subdomain as a @p + // + u3_noun sip; + c3_c* sip_c = c3_malloc(2 + dif_w); + + strncpy(sip_c + 1, hot_c, dif_w); + sip_c[0] = '~'; + sip_c[1 + dif_w] = 0; + + sip = u3dc("slaw", 'p', u3i_string(sip_c)); + free(sip_c); + + return sip; + } + } + } +} + +/* _proxy_dest(): proxy to destination +*/ +static void +_proxy_dest(u3_pcon* con_u, u3_noun sip) +{ + if ( u3_nul == sip ) { + _proxy_loop_connect(con_u); + } + else { + // XX revisit + u3_pier* pir_u = u3_pier_stub(); + u3_noun our = u3i_chubs(2, pir_u->who_d); + u3_noun hip = u3t(sip); + + if ( c3y == u3r_sing(our, hip) ) { + _proxy_loop_connect(con_u); + } + else { + // XX we should u3v_peek %j /=sein= to confirm + // that we're sponsoring this ship + // + _proxy_ward_start(con_u, u3k(hip)); + } + + u3z(our); + } + + u3z(sip); +} + +static void _proxy_peek_read(u3_pcon* con_u); + +/* _proxy_peek(): peek at proxied request for destination +*/ +static void +_proxy_peek(u3_pcon* con_u) +{ + c3_c* hot_c = 0; + + u3_proxy_pars sat_e = ( c3y == con_u->sec ) ? + _proxy_parse_sni(&con_u->buf_u, &hot_c) : + _proxy_parse_host(&con_u->buf_u, &hot_c); + + switch ( sat_e ) { + default: c3_assert(0); + + case u3_pars_fail: { + u3l_log("proxy: peek fail\n"); + _proxy_conn_close(con_u); + break; + } + + case u3_pars_moar: { + u3l_log("proxy: peek moar\n"); + // XX count retries, fail after some n + _proxy_peek_read(con_u); + break; + } + + case u3_pars_good: { + u3_noun sip = _proxy_parse_ship(hot_c); + _proxy_dest(con_u, sip); + break; + } + } + + if ( 0 != hot_c ) { + free(hot_c); + } +} + +/* _proxy_peek_read_cb(): read callback for peeking at proxied request +*/ +static void +_proxy_peek_read_cb(uv_stream_t* don_u, + ssize_t siz_w, + const uv_buf_t* buf_u) +{ + u3_pcon* con_u = don_u->data; + + if ( 0 > siz_w ) { + if ( UV_EOF != siz_w ) { + u3l_log("proxy: peek: %s\n", uv_strerror(siz_w)); + } + _proxy_conn_close(con_u); + } + else { + uv_read_stop(don_u); + + if ( 0 == con_u->buf_u.base ) { + con_u->buf_u = uv_buf_init(buf_u->base, siz_w); + } + else { + c3_w len_w = siz_w + con_u->buf_u.len; + void* ptr_v = c3_realloc(con_u->buf_u.base, len_w); + + memcpy(ptr_v + con_u->buf_u.len, buf_u->base, siz_w); + con_u->buf_u = uv_buf_init(ptr_v, len_w); + + free(buf_u->base); + } + + _proxy_peek(con_u); + } +} + +/* _proxy_peek_read(): start read to peek at proxied request +*/ +static void +_proxy_peek_read(u3_pcon* con_u) +{ + uv_read_start((uv_stream_t*)&con_u->don_u, + _proxy_alloc, _proxy_peek_read_cb); +} + +/* _proxy_serv_free(): free proxy listener +*/ +static void +_proxy_serv_free(u3_prox* lis_u) +{ + u3_pcon* con_u = lis_u->con_u; + + while ( con_u ) { + _proxy_conn_close(con_u); + con_u = con_u->nex_u; + } + + u3_ward* rev_u = lis_u->rev_u; + + while ( rev_u ) { + _proxy_ward_close(rev_u); + rev_u = rev_u->nex_u; + } + + // not unlinked here, owned directly by htp_u + + free(lis_u); +} + +/* _proxy_serv_close(): close proxy listener +*/ +static void +_proxy_serv_close(u3_prox* lis_u) +{ + uv_close((uv_handle_t*)&lis_u->sev_u, (uv_close_cb)_proxy_serv_free); +} + +/* _proxy_serv_new(): allocate proxy listener +*/ +static u3_prox* +_proxy_serv_new(u3_http* htp_u, c3_s por_s, c3_o sec) +{ + u3_prox* lis_u = c3_malloc(sizeof(*lis_u)); + lis_u->sev_u.data = lis_u; + lis_u->por_s = por_s; + lis_u->sec = sec; + lis_u->htp_u = htp_u; + lis_u->con_u = 0; + lis_u->rev_u = 0; + + // not linked here, owned directly by htp_u + + return lis_u; +} + +/* _proxy_serv_accept(): accept new connection. +*/ +static void +_proxy_serv_accept(u3_prox* lis_u) +{ + u3_pcon* con_u = _proxy_conn_new(u3_ptyp_prox, lis_u); + + uv_tcp_init(u3L, &con_u->don_u); + + c3_i sas_i; + if ( 0 != (sas_i = uv_accept((uv_stream_t*)&lis_u->sev_u, + (uv_stream_t*)&con_u->don_u)) ) { + u3l_log("proxy: accept: %s\n", uv_strerror(sas_i)); + _proxy_conn_close(con_u); + } + else { + _proxy_peek_read(con_u); + } +} + +/* _proxy_serv_listen_cb(): listen callback for proxy server. +*/ +static void +_proxy_serv_listen_cb(uv_stream_t* sev_u, c3_i sas_i) +{ + u3_prox* lis_u = (u3_prox*)sev_u; + + if ( 0 != sas_i ) { + u3l_log("proxy: listen_cb: %s\n", uv_strerror(sas_i)); + } + else { + _proxy_serv_accept(lis_u); + } +} + +/* _proxy_serv_start(): start reverse TCP proxy server. +*/ +static u3_prox* +_proxy_serv_start(u3_prox* lis_u) +{ + uv_tcp_init(u3L, &lis_u->sev_u); + + struct sockaddr_in add_u; + + memset(&add_u, 0, sizeof(add_u)); + add_u.sin_family = AF_INET; + add_u.sin_addr.s_addr = INADDR_ANY; + + /* Try ascending ports. + */ + while ( 1 ) { + c3_i sas_i; + + add_u.sin_port = htons(lis_u->por_s); + + if ( 0 != (sas_i = uv_tcp_bind(&lis_u->sev_u, + (const struct sockaddr*)&add_u, 0)) || + 0 != (sas_i = uv_listen((uv_stream_t*)&lis_u->sev_u, + TCP_BACKLOG, _proxy_serv_listen_cb)) ) { + if ( (UV_EADDRINUSE == sas_i) || (UV_EACCES == sas_i) ) { + if ( (c3y == lis_u->sec) && (443 == lis_u->por_s) ) { + lis_u->por_s = 9443; + } + else if ( (c3n == lis_u->sec) && (80 == lis_u->por_s) ) { + lis_u->por_s = 9080; + } + else { + lis_u->por_s++; + } + + continue; + } + + u3l_log("proxy: listen: %s\n", uv_strerror(sas_i)); + _proxy_serv_free(lis_u); + return 0; + } + + return lis_u; + } +} + +/* u3_http_ef_that(): reverse proxy requested connection notification. +*/ +void +u3_http_ef_that(u3_noun tat) +{ + u3_noun sip, por, sec, non; + + if ( ( c3n == u3r_qual(tat, &sip, &por, &sec, &non) ) || + ( c3n == u3ud(sip) ) || + ( c3n == u3a_is_cat(por) ) || + !( c3y == sec || c3n == sec ) || + ( c3n == u3ud(non) ) ) { + u3l_log("http: that: invalid card\n"); + } + else { + u3_http* htp_u; + u3_warc* cli_u; + + for ( htp_u = u3_Host.htp_u; (0 != htp_u); htp_u = htp_u->nex_u ) { + if ( c3n == htp_u->lop && sec == htp_u->sec ) { + break; + } + } + + // XX we should inform our sponsor if we aren't running a server + // so this situation can be avoided + // + if ( 0 == htp_u ) { + u3l_log("http: that: no %s server\n", + (c3y == sec) ? "secure" : "insecure"); + } + else { + cli_u = _proxy_warc_new(htp_u, (u3_atom)u3k(sip), (u3_atom)u3k(non), + (c3_s)por, (c3_o)sec); + + // resolve to loopback if networking is disabled + // + if ( c3n == u3_Host.ops_u.net ) { + cli_u->ipf_w = INADDR_LOOPBACK; + _proxy_ward_connect(cli_u); + } + else { + _proxy_ward_resolve(cli_u); + } + } + } + + u3z(tat); +} diff --git a/pkg/hs/vere/notes/c/lmdb.c b/pkg/hs/vere/notes/c/lmdb.c new file mode 100644 index 000000000..8a5fd9d90 --- /dev/null +++ b/pkg/hs/vere/notes/c/lmdb.c @@ -0,0 +1,670 @@ +/* vere/lmdb.c +*/ + +#include "all.h" + +#include +#include + +#include "vere/vere.h" + +// Event log persistence for Urbit +// +// Persistence works by having an lmdb environment opened on the main +// thread. This environment is used to create read-only transactions +// synchronously when needed. +// +// But the majority of lmdb writes operate asynchronously in the uv worker +// pool. Since individual transactions are bound to threads, we perform all +// blocking writing on worker threads. +// +// We perform the very first metadata writes on the main thread because we +// can't do anything until they persist. + +/* u3_lmdb_init(): Opens up a log environment +** +** Precondition: log_path points to an already created directory +*/ +MDB_env* u3_lmdb_init(const char* log_path) +{ + MDB_env* env = 0; + c3_w ret_w = mdb_env_create(&env); + if (ret_w != 0) { + u3l_log("lmdb: init fail: %s\n", mdb_strerror(ret_w)); + return 0; + } + + // Our databases have up to three tables: META, EVENTS, and GRAINS. + ret_w = mdb_env_set_maxdbs(env, 3); + if (ret_w != 0) { + u3l_log("lmdb: failed to set number of databases: %s\n", mdb_strerror(ret_w)); + return 0; + } + + // TODO: Start with forty gigabytes for the maximum event log size. We'll + // need to do something more sophisticated for real in the long term, though. + // + const size_t forty_gigabytes = 42949672960; + ret_w = mdb_env_set_mapsize(env, forty_gigabytes); + if (ret_w != 0) { + u3l_log("lmdb: failed to set database size: %s\n", mdb_strerror(ret_w)); + return 0; + } + + ret_w = mdb_env_open(env, log_path, 0, 0664); + if (ret_w != 0) { + u3l_log("lmdb: failed to open event log: %s\n", mdb_strerror(ret_w)); + return 0; + } + + return env; +} + +/* u3_lmdb_shutdown(): Shuts down lmdb +*/ +void u3_lmdb_shutdown(MDB_env* env) +{ + mdb_env_close(env); +} + +/* _perform_put_on_database_raw(): Writes a key/value pair to a specific +** database as part of a transaction. +** +** The raw version doesn't take ownership of either key/value and performs no +** nock calculations, so it is safe to call from any thread. +*/ +static +c3_o _perform_put_on_database_raw(MDB_txn* transaction_u, + MDB_dbi database_u, + c3_w flags, + void* key, + size_t key_len, + void* value, + size_t value_len) { + MDB_val key_val, value_val; + + key_val.mv_size = key_len; + key_val.mv_data = key; + + value_val.mv_size = value_len; + value_val.mv_data = value; + + c3_w ret_w = mdb_put(transaction_u, database_u, &key_val, &value_val, flags); + if (ret_w != 0) { + u3l_log("lmdb: write failed: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + return c3y; +} + +/* _perform_get_on_database_raw(): Reads a key/value pair to a specific +** database as part of a transaction. +*/ +static +c3_o _perform_get_on_database_raw(MDB_txn* transaction_u, + MDB_dbi database_u, + void* key, + size_t key_len, + MDB_val* value) { + MDB_val key_val; + key_val.mv_size = key_len; + key_val.mv_data = key; + + c3_w ret_w = mdb_get(transaction_u, database_u, &key_val, value); + if (ret_w != 0) { + u3l_log("lmdb: read failed: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + return c3y; +} + +/* _perform_put_on_database_noun(): Writes a noun to the database. +** +** This requires access to the loom so it must only be run from the libuv +** thread. +*/ +static +c3_o _perform_put_on_database_noun(MDB_txn* transaction_u, + MDB_dbi database_u, + c3_c* key, + u3_noun noun) { + // jam noun into an atom representation + u3_atom mat = u3ke_jam(noun); + + // copy the jammed noun into a byte buffer we can hand to lmdb + c3_w len_w = u3r_met(3, mat); + c3_y* bytes_y = (c3_y*) malloc(len_w); + u3r_bytes(0, len_w, bytes_y, mat); + + c3_o ret = _perform_put_on_database_raw( + transaction_u, + database_u, + 0, + key, strlen(key), + bytes_y, len_w); + + free(bytes_y); + u3z(mat); + + return ret; +} + +/* _perform_get_on_database_noun(): Reads a noun from the database. +** +** This requires access to the loom so it must only be run from the libuv +** thread. +*/ +static +c3_o _perform_get_on_database_noun(MDB_txn* transaction_u, + MDB_dbi database_u, + c3_c* key, + u3_noun* noun) { + MDB_val value_val; + c3_o ret = _perform_get_on_database_raw(transaction_u, + database_u, + key, strlen(key), + &value_val); + if (ret == c3n) { + return c3y; + } + + // Take the bytes and cue them. + u3_atom raw_atom = u3i_bytes(value_val.mv_size, value_val.mv_data); + *noun = u3qe_cue(raw_atom); + return c3y; +} + +/* u3_lmdb_write_request: Events to be written together +*/ +struct u3_lmdb_write_request { + // The event number of the first event. + c3_d first_event; + + // The number of events in this write request. Nonzero. + c3_d event_count; + + // An array of serialized event datas. The array size is |event_count|. We + // perform the event serialization on the main thread so we can read the loom + // and write into a malloced structure for the worker thread. + void** malloced_event_data; + + // An array of sizes of serialized event datas. We keep track of this for the + // database write. + size_t* malloced_event_data_size; +}; + +/* u3_lmdb_build_write_request(): Allocates and builds a write request +*/ +struct u3_lmdb_write_request* +u3_lmdb_build_write_request(u3_writ* event_u, c3_d count) +{ + struct u3_lmdb_write_request* request = + c3_malloc(sizeof(struct u3_lmdb_write_request)); + request->first_event = event_u->evt_d; + request->event_count = count; + request->malloced_event_data = c3_malloc(sizeof(void*) * count); + request->malloced_event_data_size = c3_malloc(sizeof(size_t) * count); + + for (c3_d i = 0; i < count; ++i) { + // Sanity check that the events in u3_writ are in order. + c3_assert(event_u->evt_d == (request->first_event + i)); + + // Serialize the jammed event log entry into a malloced buffer we can send + // to the other thread. + c3_w siz_w = u3r_met(3, event_u->mat); + c3_y* data_u = c3_calloc(siz_w); + u3r_bytes(0, siz_w, data_u, event_u->mat); + + request->malloced_event_data[i] = data_u; + request->malloced_event_data_size[i] = siz_w; + + event_u = event_u->nex_u; + } + + return request; +} + +/* u3_lmdb_free_write_request(): Frees a write request +*/ +void u3_lmdb_free_write_request(struct u3_lmdb_write_request* request) { + for (c3_d i = 0; i < request->event_count; ++i) + free(request->malloced_event_data[i]); + + free(request->malloced_event_data); + free(request->malloced_event_data_size); + free(request); +} + +/* _write_request_data: callback struct for u3_lmdb_write_event() +*/ +struct _write_request_data { + // The database environment to write to. This object is thread-safe, though + // the transactions and handles opened from it are explicitly not. + MDB_env* environment; + + // The pier that we're writing for. + u3_pier* pir_u; + + // The encapsulated request. This may contain multiple event writes. + struct u3_lmdb_write_request* request; + + // Whether the write completed successfully. + c3_o success; + + // Called on main loop thread on completion. + void (*on_complete)(c3_o, u3_pier*, c3_d, c3_d); +}; + +/* _u3_lmdb_write_event_cb(): Implementation of u3_lmdb_write_event() +** +** This is always run on a libuv background worker thread; actual nouns cannot +** be touched here. +*/ +static void _u3_lmdb_write_event_cb(uv_work_t* req) { + struct _write_request_data* data = req->data; + + // Creates the write transaction. + MDB_txn* transaction_u; + c3_w ret_w = mdb_txn_begin(data->environment, + (MDB_txn *) NULL, + 0, /* flags */ + &transaction_u); + if (0 != ret_w) { + u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return; + } + + // Opens the database as part of the transaction. + c3_w flags_w = MDB_CREATE | MDB_INTEGERKEY; + MDB_dbi database_u; + ret_w = mdb_dbi_open(transaction_u, + "EVENTS", + flags_w, + &database_u); + if (0 != ret_w) { + u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + return; + } + + struct u3_lmdb_write_request* request = data->request; + for (c3_d i = 0; i < request->event_count; ++i) { + c3_d event_number = request->first_event + i; + + c3_o success = _perform_put_on_database_raw( + transaction_u, + database_u, + MDB_NOOVERWRITE, + &event_number, + sizeof(c3_d), + request->malloced_event_data[i], + request->malloced_event_data_size[i]); + + if (success == c3n) { + u3l_log("lmdb: failed to write event %" PRIu64 "\n", event_number); + mdb_txn_abort(transaction_u); + data->success = c3n; + return; + } + } + + ret_w = mdb_txn_commit(transaction_u); + if (0 != ret_w) { + if ( request->event_count == 1 ) { + u3l_log("lmdb: failed to commit event %" PRIu64 ": %s\n", + request->first_event, + mdb_strerror(ret_w)); + } else { + c3_d through = request->first_event + request->event_count - 1ULL; + u3l_log("lmdb: failed to commit events %" PRIu64 " through %" PRIu64 + ": %s\n", + request->first_event, + through, + mdb_strerror(ret_w)); + } + data->success = c3n; + return; + } + + data->success = c3y; +} + +/* _u3_lmdb_write_event_after_cb(): Implementation of u3_lmdb_write_event() +** +** This is always run on the main loop thread after the worker thread event +** completes. +*/ +static void _u3_lmdb_write_event_after_cb(uv_work_t* req, int status) { + struct _write_request_data* data = req->data; + + data->on_complete(data->success, + data->pir_u, + data->request->first_event, + data->request->event_count); + + u3_lmdb_free_write_request(data->request); + free(data); + free(req); +} + +/* u3_lmdb_write_event(): Asynchronously writes events to the database. +** +** This writes all the passed in events along with log metadata updates to the +** database as a single transaction on a worker thread. Once the transaction +** is completed, it calls the passed in callback on the main loop thread. +*/ +void u3_lmdb_write_event(MDB_env* environment, + u3_pier* pir_u, + struct u3_lmdb_write_request* request_u, + void (*on_complete)(c3_o, u3_pier*, c3_d, c3_d)) +{ + // Structure to pass to the worker thread. + struct _write_request_data* data = c3_malloc(sizeof(struct _write_request_data)); + data->environment = environment; + data->pir_u = pir_u; + data->request = request_u; + data->on_complete = on_complete; + data->success = c3n; + + // Queue asynchronous work to happen on the other thread. + uv_work_t* req = c3_malloc(sizeof(uv_work_t)); + req->data = data; + + uv_queue_work(uv_default_loop(), + req, + _u3_lmdb_write_event_cb, + _u3_lmdb_write_event_after_cb); +} + +/* u3_lmdb_read_events(): Synchronously reads events from the database. +** +** Reads back up to |len_d| events starting with |first_event_d|. For +** each event, the event will be passed to |on_event_read| and further +** reading will be aborted if the callback returns c3n. +** +** Returns c3y on complete success; c3n on any error. +*/ +c3_o u3_lmdb_read_events(u3_pier* pir_u, + c3_d first_event_d, + c3_d len_d, + c3_o(*on_event_read)(u3_pier* pir_u, c3_d id, + u3_noun mat)) +{ + // Creates the read transaction. + MDB_txn* transaction_u; + c3_w ret_w = mdb_txn_begin(pir_u->log_u->db_u, + //environment, + (MDB_txn *) NULL, + MDB_RDONLY, /* flags */ + &transaction_u); + if (0 != ret_w) { + u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Opens the database as part of the transaction. + c3_w flags_w = MDB_CREATE | MDB_INTEGERKEY; + MDB_dbi database_u; + ret_w = mdb_dbi_open(transaction_u, + "EVENTS", + flags_w, + &database_u); + if (0 != ret_w) { + u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Creates a cursor to iterate over keys starting at first_event_d. + MDB_cursor* cursor_u; + ret_w = mdb_cursor_open(transaction_u, database_u, &cursor_u); + if (0 != ret_w) { + u3l_log("lmdb: cursor_open fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Sets the cursor to the position of first_event_d. + MDB_val key; + MDB_val val; + key.mv_size = sizeof(c3_d); + key.mv_data = &first_event_d; + + ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_SET_KEY); + if (0 != ret_w) { + u3l_log("lmdb: could not find initial event %" PRIu64 ": %s\r\n", + first_event_d, mdb_strerror(ret_w)); + mdb_cursor_close(cursor_u); + return c3n; + } + + // Load up to len_d events, iterating forward across the cursor. + for (c3_d loaded = 0; (ret_w != MDB_NOTFOUND) && (loaded < len_d); ++loaded) { + // As a sanity check, we make sure that there aren't any discontinuities in + // the sequence of loaded events. + c3_d current_id = first_event_d + loaded; + if (key.mv_size != sizeof(c3_d)) { + u3l_log("lmdb: invalid cursor key\r\n"); + return c3n; + } + if (*(c3_d*)key.mv_data != current_id) { + u3l_log("lmdb: missing event in database. Expected %" PRIu64 ", received %" + PRIu64 "\r\n", + current_id, + *(c3_d*)key.mv_data); + return c3n; + } + + // Now build the atom version and then the cued version from the raw data + u3_noun mat = u3i_bytes(val.mv_size, val.mv_data); + + if (on_event_read(pir_u, current_id, mat) == c3n) { + u3z(mat); + u3l_log("lmdb: aborting replay due to error.\r\n"); + return c3n; + } + + u3z(mat); + + ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_NEXT); + if (ret_w != 0 && ret_w != MDB_NOTFOUND) { + u3l_log("lmdb: error while loading events: %s\r\n", + mdb_strerror(ret_w)); + return c3n; + } + } + + mdb_cursor_close(cursor_u); + + // Read-only transactions are aborted since we don't need to record the fact + // that we performed a read. + mdb_txn_abort(transaction_u); + + return c3y; +} + +/* u3_lmdb_get_latest_event_number(): Gets last event id persisted +** +** Reads the last key in order from the EVENTS table as the latest event +** number. On table empty, returns c3y but doesn't modify event_number. +*/ +c3_o u3_lmdb_get_latest_event_number(MDB_env* environment, c3_d* event_number) +{ + // Creates the read transaction. + MDB_txn* transaction_u; + c3_w ret_w = mdb_txn_begin(environment, + (MDB_txn *) NULL, + 0, /* flags */ + &transaction_u); + if (0 != ret_w) { + u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Opens the database as part of the transaction. + c3_w flags_w = MDB_CREATE | MDB_INTEGERKEY; + MDB_dbi database_u; + ret_w = mdb_dbi_open(transaction_u, + "EVENTS", + flags_w, + &database_u); + if (0 != ret_w) { + u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Creates a cursor to point to the last event + MDB_cursor* cursor_u; + ret_w = mdb_cursor_open(transaction_u, database_u, &cursor_u); + if (0 != ret_w) { + u3l_log("lmdb: cursor_open fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Set the cursor at the end of the line. + MDB_val key; + MDB_val val; + ret_w = mdb_cursor_get(cursor_u, &key, &val, MDB_LAST); + if (MDB_NOTFOUND == ret_w) { + // Clean up, but don't error out. + mdb_cursor_close(cursor_u); + mdb_txn_abort(transaction_u); + return c3y; + } + + if (0 != ret_w) { + u3l_log("lmdb: could not find last event: %s\r\n", mdb_strerror(ret_w)); + mdb_cursor_close(cursor_u); + mdb_txn_abort(transaction_u); + return c3n; + } + + *event_number = *(c3_d*)key.mv_data; + + mdb_cursor_close(cursor_u); + + // Read-only transactions are aborted since we don't need to record the fact + // that we performed a read. + mdb_txn_abort(transaction_u); + + return c3y; +} + +/* u3_lmdb_write_identity(): Writes the event log identity information +** +** We have a secondary database (table) in this environment named META where we +** read/write identity information from/to. +*/ +c3_o u3_lmdb_write_identity(MDB_env* environment, + u3_noun who, + u3_noun is_fake, + u3_noun life) +{ + // Creates the write transaction. + MDB_txn* transaction_u; + c3_w ret_w = mdb_txn_begin(environment, + (MDB_txn *) NULL, + 0, /* flags */ + &transaction_u); + if (0 != ret_w) { + u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Opens the database as part of the transaction. + c3_w flags_w = MDB_CREATE; + MDB_dbi database_u; + ret_w = mdb_dbi_open(transaction_u, + "META", + flags_w, + &database_u); + if (0 != ret_w) { + u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + mdb_txn_abort(transaction_u); + return c3n; + } + + c3_o ret; + ret = _perform_put_on_database_noun(transaction_u, database_u, "who", who); + if (ret == c3n) { + mdb_txn_abort(transaction_u); + return c3n; + } + + ret = _perform_put_on_database_noun(transaction_u, database_u, "is-fake", + is_fake); + if (ret == c3n) { + mdb_txn_abort(transaction_u); + return c3n; + } + + ret = _perform_put_on_database_noun(transaction_u, database_u, "life", life); + if (ret == c3n) { + mdb_txn_abort(transaction_u); + return c3n; + } + + ret_w = mdb_txn_commit(transaction_u); + if (0 != ret_w) { + u3l_log("lmdb: failed to commit transaction: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + return c3y; +} + + +/* u3_lmdb_read_identity(): Reads the event log identity information. +*/ +c3_o u3_lmdb_read_identity(MDB_env* environment, + u3_noun* who, + u3_noun* is_fake, + u3_noun* life) { + // Creates the write transaction. + MDB_txn* transaction_u; + c3_w ret_w = mdb_txn_begin(environment, + (MDB_txn *) NULL, + MDB_RDONLY, /* flags */ + &transaction_u); + if (0 != ret_w) { + u3l_log("lmdb: txn_begin fail: %s\n", mdb_strerror(ret_w)); + return c3n; + } + + // Opens the database as part of the transaction. + MDB_dbi database_u; + ret_w = mdb_dbi_open(transaction_u, + "META", + 0, + &database_u); + if (0 != ret_w) { + u3l_log("lmdb: dbi_open fail: %s\n", mdb_strerror(ret_w)); + mdb_txn_abort(transaction_u); + return c3n; + } + + c3_o ret; + ret = _perform_get_on_database_noun(transaction_u, database_u, "who", who); + if (ret == c3n) { + mdb_txn_abort(transaction_u); + return c3n; + } + + ret = _perform_get_on_database_noun(transaction_u, database_u, "is-fake", + is_fake); + if (ret == c3n) { + mdb_txn_abort(transaction_u); + return c3n; + } + + ret = _perform_get_on_database_noun(transaction_u, database_u, "life", life); + if (ret == c3n) { + mdb_txn_abort(transaction_u); + return c3n; + } + + // Read-only transactions are aborted since we don't need to record the fact + // that we performed a read. + mdb_txn_abort(transaction_u); + + return c3y; +} diff --git a/pkg/hs/vere/notes/c/newt.c b/pkg/hs/vere/notes/c/newt.c new file mode 100644 index 000000000..67a220daa --- /dev/null +++ b/pkg/hs/vere/notes/c/newt.c @@ -0,0 +1,359 @@ +/* vere/newt.c +** +** implements noun blob messages with trivial framing. +** +** a message is a 64-bit little-endian byte count, followed +** by the indicated number of bytes. the bytes are the +** the ++cue of of a noun. +** +** the implementation is relatively inefficient and could +** lose a few copies, mallocs, etc. +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +#undef NEWT_VERBOSE + +/* _newt_consume(): advance buffer processing. +*/ +static void +_newt_consume(u3_moat* mot_u) +{ + /* process stray bytes, trying to create a new message + ** or add a block to an existing one. + */ + while ( 1 ) { + if ( mot_u->rag_y ) { + /* if there is a live message, add a block to the queue. + */ + if ( mot_u->mes_u ) { + u3_meat* met_u; + + /* create block + */ + met_u = c3_malloc(mot_u->len_d + (c3_d) sizeof(u3_meat)); + met_u->nex_u = 0; + met_u->len_d = mot_u->len_d; + memcpy(met_u->hun_y, mot_u->rag_y, mot_u->len_d); + +#ifdef NEWT_VERBOSE + u3l_log("newt: %d: create: msg %p, new block %p, len %" + PRIu64 ", has %" PRIu64 ", needs %" PRIu64 "\r\n", + getpid(), + mot_u->mes_u, + met_u, + met_u->len_d, + mot_u->mes_u->has_d, + mot_u->mes_u->len_d); +#endif + /* enqueue block + */ + if ( !mot_u->mes_u->meq_u ) { + mot_u->mes_u->meq_u = mot_u->mes_u->qem_u = met_u; + } + else { + mot_u->mes_u->qem_u->nex_u = met_u; + mot_u->mes_u->qem_u = met_u; + } + mot_u->mes_u->has_d += met_u->len_d; + + /* free consumed stray bytes + */ + c3_free(mot_u->rag_y); + mot_u->len_d = 0; + mot_u->rag_y = 0; + } + else { + /* no message, but enough stray bytes to fill in + ** a length; collect them and create a message. + */ + if ( mot_u->len_d >= 8ULL ) { + c3_d nel_d = 0; + + nel_d |= ((c3_d) mot_u->rag_y[0]) << 0ULL; + nel_d |= ((c3_d) mot_u->rag_y[1]) << 8ULL; + nel_d |= ((c3_d) mot_u->rag_y[2]) << 16ULL; + nel_d |= ((c3_d) mot_u->rag_y[3]) << 24ULL; + nel_d |= ((c3_d) mot_u->rag_y[4]) << 32ULL; + nel_d |= ((c3_d) mot_u->rag_y[5]) << 40ULL; + nel_d |= ((c3_d) mot_u->rag_y[6]) << 48ULL; + nel_d |= ((c3_d) mot_u->rag_y[7]) << 56ULL; + +#ifdef NEWT_VERBOSE + u3l_log("newt: %d: parsed length %" PRIu64 "\r\n", + getpid(), + nel_d); +#endif + mot_u->len_d -= 8ULL; + + mot_u->mes_u = c3_malloc(sizeof(u3_mess)); + mot_u->mes_u->len_d = nel_d; + mot_u->mes_u->has_d = 0; + mot_u->mes_u->meq_u = mot_u->mes_u->qem_u = 0; + + if ( !mot_u->len_d ) { + c3_free(mot_u->rag_y); + mot_u->rag_y = 0; + } + else { + /* remove consumed length from stray bytes + */ + c3_y* buf_y = c3_malloc(mot_u->len_d); + + memcpy(buf_y, mot_u->rag_y + 8, mot_u->len_d); + + c3_free(mot_u->rag_y); + mot_u->rag_y = buf_y; + + /* remaining bytes will be installed as message meat + */ + continue; + } + } + } + } + + /* check for message completions + */ + if ( mot_u->mes_u && (mot_u->mes_u->has_d >= mot_u->mes_u->len_d) ) { + c3_d len_d = mot_u->mes_u->len_d; + c3_y* buf_y = c3_malloc(len_d); + c3_d pat_d = 0; + u3_meat* met_u; + + /* we should have just cleared this + */ + c3_assert(!mot_u->rag_y); + c3_assert(!mot_u->len_d); + + /* collect queue blocks, cleaning them up; return any spare meat + ** to the rag. + */ + { + met_u = mot_u->mes_u->meq_u; + while ( met_u && (pat_d < len_d) ) { + u3_meat* nex_u = met_u->nex_u; + c3_d end_d = (pat_d + met_u->len_d); + c3_d eat_d; + c3_d rem_d; + + eat_d = c3_min(len_d, end_d) - pat_d; + memcpy(buf_y + pat_d, met_u->hun_y, eat_d); + pat_d += eat_d; + + rem_d = (met_u->len_d - eat_d); + if ( rem_d ) { + mot_u->rag_y = c3_malloc(rem_d); + memcpy(mot_u->rag_y, met_u->hun_y + eat_d, rem_d); + mot_u->len_d = rem_d; + + /* one: unless we got a bad length, this has to be the last + ** block in the message. + ** + ** two: bad data on a newt channel can cause us to assert. + ** that's actually the right thing for a private channel. + */ + c3_assert(0 == nex_u); + } + c3_free(met_u); + met_u = nex_u; + } + c3_assert(pat_d == len_d); + + /* clear the message + */ + c3_free(mot_u->mes_u); + mot_u->mes_u = 0; + } + + /* build and send the object + */ + { + u3_noun mat = u3i_bytes((c3_w) len_d, buf_y); + + mot_u->pok_f(mot_u->vod_p, mat); + } + + /* continue; spare meat may need processing + */ + continue; + } + + /* nothing happening, await next event + */ + break; + } +} + +/* _raft_alloc(): libuv-style allocator for raft. +*/ +static void +_newt_alloc(uv_handle_t* had_u, + size_t len_i, + uv_buf_t* buf_u) +{ + void* ptr_v = c3_malloc(len_i); + + *buf_u = uv_buf_init(ptr_v, len_i); +} + +/* _newt_read_cb(): stream input callback. +*/ +void +_newt_read_cb(uv_stream_t* str_u, + ssize_t len_i, + const uv_buf_t* buf_u) +{ + c3_d len_d = (c3_d) len_i; + u3_moat* mot_u = (void *)str_u; + + if ( UV_EOF == len_i ) { + // u3l_log("newt: %d: stream closed\r\n", getpid()); + uv_read_stop(str_u); + mot_u->bal_f(mot_u->vod_p, "stream closed"); + } + else { +#ifdef NEWT_VERBOSE + u3l_log("newt: %d: read %ld\r\n", getpid(), len_i); +#endif + +#ifdef NEWT_VERBOSE + u3l_log("newt: %d: ", getpid()); + for ( int i = 0; i < len_i; i++) { + if (0 == (i % 16)) u3l_log("\r\n"); + u3l_log(" %02x", (unsigned) buf_u->base[i]); + } + u3l_log("\r\nnewt: %d: \r\n", getpid()); +#endif + + // grow read buffer by `len_d` bytes + // + if ( mot_u->rag_y ) { + mot_u->rag_y = c3_realloc(mot_u->rag_y, mot_u->len_d + len_d); + memcpy(mot_u->rag_y + mot_u->len_d, buf_u->base, len_d); + c3_free(buf_u->base); + } + else { + mot_u->rag_y = (c3_y *)buf_u->base; + mot_u->len_d = len_d; + } + _newt_consume(mot_u); + } +} + +/* u3_newt_read(): start stream reading. +*/ +void +u3_newt_read(u3_moat* mot_u) +{ + c3_i err_i; + + mot_u->mes_u = 0; + mot_u->len_d = 0; + mot_u->rag_y = 0; + + err_i = uv_read_start((uv_stream_t*) &mot_u->pyp_u, + _newt_alloc, + _newt_read_cb); + + if ( err_i != 0 ) { + mot_u->bal_f(mot_u, uv_strerror(err_i)); + } +} + +/* write request for newt +*/ + struct _u3_write_t { + uv_write_t wri_u; + u3_mojo* moj_u; + void* vod_p; + c3_y* buf_y; + }; + +/* _newt_write_cb(): generic write callback. +*/ +static void +_newt_write_cb(uv_write_t* wri_u, c3_i sas_i) +{ + struct _u3_write_t* req_u = (struct _u3_write_t*)wri_u; + void* vod_p = req_u->vod_p; + u3_mojo* moj_u = req_u->moj_u; + + free(req_u->buf_y); + free(req_u); + + if ( 0 != sas_i ) { + u3l_log("newt: bad write %d\r\n", sas_i); + moj_u->bal_f(vod_p, uv_strerror(sas_i)); + } +} + +/* u3_newt_write(): write atom to stream; free atom. +*/ +void +u3_newt_write(u3_mojo* moj_u, + u3_atom mat, + void* vod_p) +{ + c3_w len_w = u3r_met(3, mat); + c3_y* buf_y = c3_malloc(len_w + 8); + struct _u3_write_t* req_u = c3_malloc(sizeof(*req_u)); + uv_buf_t buf_u; + c3_i err_i; + + /* write header; c3_d is futureproofing + */ + buf_y[0] = ((len_w >> 0) & 0xff); + buf_y[1] = ((len_w >> 8) & 0xff); + buf_y[2] = ((len_w >> 16) & 0xff); + buf_y[3] = ((len_w >> 24) & 0xff); + buf_y[4] = buf_y[5] = buf_y[6] = buf_y[7] = 0; + u3r_bytes(0, len_w, buf_y + 8, mat); + u3z(mat); + + req_u->moj_u = moj_u; + req_u->buf_y = buf_y; + buf_u.base = (c3_c*) buf_y; + buf_u.len = len_w + 8; + +#ifdef NEWT_VERBOSE + u3l_log("newt: %d: write %d\n", getpid(), len_w + 8); +#endif + +#ifdef NEWT_VERBOSE + u3l_log("newt: %d: ", getpid()); + for ( int i = 0; i < len_w+8; i++) { + if (0 == (i % 16)) u3l_log("\r\n"); + u3l_log(" %02x", (unsigned) buf_u.base[i]); + } + u3l_log("\r\nnewt: %d: \r\n", getpid()); +#endif + + if ( 0 != (err_i = uv_write((uv_write_t*)req_u, + (uv_stream_t*)&moj_u->pyp_u, + &buf_u, + 1, + _newt_write_cb)) ) + { + moj_u->bal_f(moj_u, uv_strerror(err_i)); + } +} diff --git a/pkg/hs/vere/notes/c/pier.c b/pkg/hs/vere/notes/c/pier.c new file mode 100644 index 000000000..730e47f09 --- /dev/null +++ b/pkg/hs/vere/notes/c/pier.c @@ -0,0 +1,2143 @@ +/* vere/pier.c +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +#undef VERBOSE_EVENTS + + /* event handling proceeds on a single path. across both the + ** child worker process (worker) and parent i/o process (daemon). + ** state transitions are as follows: + ** + ** generated (event numbered and queued) + ** dispatched (sent to worker) + ** computed (completed by worker) + ** commit requested (sent to storage subsystem) + ** commit complete (daemon notified) + ** released (output actions allowed) + ** + ** we dispatch one event at a time to the worker. we don't do + ** anything in parallel. + ** + ** the sanity constraints that constrain this path: + ** + ** - an event can't request a commit until it's computed. + ** - an event can't be released until it, and all events + ** preceding it, are computed and committed. + ** + ** event numbers are uint64 (c3_d) which start with 1. we order + ** events as we receive them. + ** + ** events are executed in order by the working process, and + ** (at present) committed in strict order. + ** + ** the result of computing an event can be completion (in which + ** case we go directly to commit) or replacement (in which we + ** replace the input event with a different event). + ** + ** after crash recovery, events committed but not in the snapshot + ** (the state of the worker) are replayed (re-computed), but their + ** output effects are ignored. it is possible that effects of + ** (only the last of ?) these events are not completely released to + ** the outside world -- but they should never be released more than once. + ** + ** XX analyze replay more comprehensively + */ + +static void _pier_apply(u3_pier* pir_u); +static void _pier_boot_complete(u3_pier* pir_u); +static void _pier_boot_ready(u3_pier* pir_u); +static void _pier_boot_set_ship(u3_pier* pir_u, u3_noun who, u3_noun fak); +static void _pier_exit_done(u3_pier* pir_u); +static void _pier_loop_resume(u3_pier* pir_u); + +/* _pier_db_bail(): bail from disk i/o. +*/ +static void +_pier_db_bail(void* vod_p, const c3_c* err_c) +{ + u3l_log("disk error: %s\r\n", err_c); +} + +/* _pier_db_shutdown(): close the log. +*/ +static void +_pier_db_shutdown(u3_pier* pir_u) +{ + u3_lmdb_shutdown(pir_u->log_u->db_u); +} + +/* _pier_db_commit_complete(): commit complete. + */ +static void +_pier_db_commit_complete(c3_o success, + u3_pier* pir_u, + c3_d first_event_d, + c3_d event_count_d) +{ + u3_disk* log_u = pir_u->log_u; + + if (success == c3n) { + u3l_log("Failed to persist event. Exiting to prevent corruption."); + u3_pier_bail(); + } + +#ifdef VERBOSE_EVENTS + if (event_count_d != 1) { + u3l_log("pier: (%" PRIu64 "-%" PRIu64 "): db commit: complete\r\n", + first_event_d, first_event_d + event_count_d - 1ULL); + } else { + u3l_log("pier: (%" PRIu64 "): db commit: complete\r\n", first_event_d); + } +#endif + + /* advance commit counter + */ + { + c3_assert((first_event_d + event_count_d - 1ULL) == log_u->moc_d); + c3_assert(first_event_d == (1ULL + log_u->com_d)); + log_u->com_d += event_count_d; + } + + _pier_loop_resume(pir_u); +} + +/* _pier_db_commit_request(): start commit. +*/ +static void +_pier_db_commit_request(u3_pier* pir_u, + struct u3_lmdb_write_request* request_u, + c3_d first_event_d, + c3_d count_d) +{ + u3_disk* log_u = pir_u->log_u; + +#ifdef VERBOSE_EVENTS + if (count_d != 1) { + u3l_log("pier: (%" PRIu64 "-%" PRIu64 "): db commit: request\r\n", + first_event_d, first_event_d + count_d - 1ULL); + } else { + u3l_log("pier: (%" PRIu64 "): db commit: request\r\n", first_event_d); + } +#endif + + /* put it in the database + */ + { + u3_lmdb_write_event(log_u->db_u, + pir_u, + request_u, + _pier_db_commit_complete); + } + + /* advance commit-request counter + */ + { + c3_assert(first_event_d == (1ULL + log_u->moc_d)); + log_u->moc_d += count_d; + } +} + + +static void +_pier_db_write_header(u3_pier* pir_u, + u3_noun who, + u3_noun is_fake, + u3_noun life) +{ + c3_o ret = u3_lmdb_write_identity(pir_u->log_u->db_u, + who, is_fake, life); + if (ret == c3n) { + u3_pier_bail(); + } +} + +/* _pier_db_read_header(): reads the ships metadata from lmdb + */ +static void +_pier_db_read_header(u3_pier* pir_u) +{ + u3_noun who, is_fake, life; + c3_o ret = u3_lmdb_read_identity(pir_u->log_u->db_u, + &who, &is_fake, &life); + if (ret == c3n) { + u3l_log("Failed to load identity. Exiting..."); + u3_pier_bail(); + } + + _pier_boot_set_ship(pir_u, u3k(who), u3k(is_fake)); + pir_u->lif_d = u3r_chub(0, life); + + u3z(who); + u3z(is_fake); + u3z(life); +} + +static c3_o +_pier_db_on_commit_loaded(u3_pier* pir_u, + c3_d id, + u3_noun mat) +{ + // Need to grab references to the nouns above. + u3_writ* wit_u = c3_calloc(sizeof(u3_writ)); + wit_u->pir_u = pir_u; + wit_u->evt_d = id; + wit_u->mat = u3k(mat); + + // Parse the expected mug_l and job out of mat. + u3_noun entry = u3ke_cue(u3k(mat)); + u3_noun mug, job; + if ( (c3y != u3du(entry)) || + (c3n == u3r_cell(entry, &mug, &job)) || + (c3n == u3ud(mug)) || + (1 < u3r_met(5, mug)) ) { + u3l_log("pier: load: event %" PRIu64 " malformed.\r\n", id); + return c3n; + } + + wit_u->mug_l = u3r_word(0, mug); + wit_u->job = u3k(job); + + u3z(entry); + + // Insert at queue front since we're loading events in order + if ( !pir_u->ent_u ) { + c3_assert(!pir_u->ext_u); + + pir_u->ent_u = pir_u->ext_u = wit_u; + } + else { + if ( wit_u->evt_d != (1ULL + pir_u->ent_u->evt_d) ) { + fprintf(stderr, "pier: load: commit: event gap: %" PRIx64 ", %" + PRIx64 "\r\n", + wit_u->evt_d, + pir_u->ent_u->evt_d); + _pier_db_bail(0, "pier: load: comit: event gap"); + return c3n; + } + + pir_u->ent_u->nex_u = wit_u; + pir_u->ent_u = wit_u; + } + + return c3y; +} + +/* _pier_db_load_commit(): load len_d commits >= lav_d; enqueue for replay +*/ +static void +_pier_db_load_commits(u3_pier* pir_u, + c3_d lav_d, + c3_d len_d) +{ + if (lav_d == 1) { + // We are restarting from event 1. That means we need to set the ship from + // the log identity information. + u3_noun who, fak, len; + c3_o ret = u3_lmdb_read_identity(pir_u->log_u->db_u, + &who, + &fak, + &len); + if (ret == c3n) { + u3l_log("Failed to load identity for replay. Exiting..."); + u3_pier_bail(); + } + + _pier_boot_set_ship(pir_u, u3k(who), u3k(fak)); + pir_u->lif_d = u3r_chub(0, len); + + u3z(who); + u3z(fak); + u3z(len); + } + + c3_o ret = u3_lmdb_read_events(pir_u, + lav_d, + len_d, + _pier_db_on_commit_loaded); + if (ret == c3n) { + u3l_log("Failed to read event log for replay. Exiting..."); + u3_pier_bail(); + } +} + +/* _pier_db_init(): +*/ +static c3_o +_pier_db_init(u3_disk* log_u) +{ + c3_d evt_d = 0; + c3_d pos_d = 0; + + c3_assert( c3n == log_u->liv_o ); + + // Request from the database the last event + if ( c3n == u3_lmdb_get_latest_event_number(log_u->db_u, &evt_d) ) { + u3l_log("disk init from lmdb failed."); + return c3n; + } + + log_u->liv_o = c3y; + log_u->com_d = log_u->moc_d = evt_d; + + _pier_boot_ready(log_u->pir_u); + + return c3y; +} + +/* _pier_disk_create(): load log for given point. +*/ +static c3_o +_pier_disk_create(u3_pier* pir_u) +{ + u3_disk* log_u = c3_calloc(sizeof(*log_u)); + + pir_u->log_u = log_u; + log_u->pir_u = pir_u; + log_u->liv_o = c3n; + + /* create/load pier, urbit directory, log directory. + */ + { + /* pier directory + */ + { + if ( 0 == (log_u->dir_u = u3_foil_folder(pir_u->pax_c)) ) { + return c3n; + } + } + + /* pier/.urb + */ + { + c3_c* urb_c = c3_malloc(6 + strlen(pir_u->pax_c)); + + strcpy(urb_c, pir_u->pax_c); + strcat(urb_c, "/.urb"); + + if ( 0 == (log_u->urb_u = u3_foil_folder(urb_c)) ) { + c3_free(urb_c); + return c3n; + } + c3_free(urb_c); + } + + /* pier/.urb/log + */ + { + c3_c* log_c = c3_malloc(10 + strlen(pir_u->pax_c)); + + strcpy(log_c, pir_u->pax_c); + strcat(log_c, "/.urb/log"); + + // Creates the folder + if ( 0 == (log_u->com_u = u3_foil_folder(log_c)) ) { + c3_free(log_c); + return c3n; + } + + // Inits the database + if ( 0 == (log_u->db_u = u3_lmdb_init(log_c)) ) { + c3_free(log_c); + return c3n; + } + + c3_free(log_c); + } + + /* pier/.urb/put and pier/.urb/get + */ + { + c3_c* dir_c = c3_malloc(10 + strlen(pir_u->pax_c)); + + strcpy(dir_c, pir_u->pax_c); + strcat(dir_c, "/.urb/put"); + mkdir(dir_c, 0700); + + strcpy(dir_c, pir_u->pax_c); + strcat(dir_c, "/.urb/get"); + mkdir(dir_c, 0700); + + c3_free(dir_c); + } + } + + // create/load event log + // + if ( c3n == _pier_db_init(log_u) ) { + return c3n; + } + + return c3y; +} + +/* _pier_writ_insert(): insert raw event. +*/ +static void +_pier_writ_insert(u3_pier* pir_u, + c3_l msc_l, + u3_noun job) +{ + u3_writ* wit_u = c3_calloc(sizeof(u3_writ)); + wit_u->pir_u = pir_u; + + wit_u->evt_d = pir_u->gen_d; + pir_u->gen_d++; + + wit_u->msc_l = msc_l; + + wit_u->job = job; + + if ( !pir_u->ent_u ) { + c3_assert(!pir_u->ext_u); + + pir_u->ent_u = pir_u->ext_u = wit_u; + } + else { + pir_u->ent_u->nex_u = wit_u; + pir_u->ent_u = wit_u; + } +} + +/* _pier_writ_insert_ovum(): insert raw ovum - for boot sequence. +*/ +static void +_pier_writ_insert_ovum(u3_pier* pir_u, + c3_l msc_l, + u3_noun ovo) +{ + u3_noun now; + struct timeval tim_tv; + + gettimeofday(&tim_tv, 0); + now = u3_time_in_tv(&tim_tv); + + _pier_writ_insert(pir_u, msc_l, u3nc(now, ovo)); +} + +/* _pier_writ_find(): find writ by event number. +*/ +static u3_writ* +_pier_writ_find(u3_pier* pir_u, + c3_d evt_d) +{ + u3_writ* wit_u; + + /* very unlikely to be O(n) and n is small + */ + for ( wit_u = pir_u->ext_u; wit_u; wit_u = wit_u->nex_u ) { + if ( evt_d == wit_u->evt_d ) { + return wit_u; + } + } + return 0; +} + +/* _pier_writ_unlink(): unlink writ from queue. +*/ +static void +_pier_writ_unlink(u3_writ* wit_u) +{ + u3_pier* pir_u = wit_u->pir_u; + +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): delete\r\n", wit_u->evt_d); +#endif + + pir_u->ext_u = wit_u->nex_u; + + if ( wit_u == pir_u->ent_u ) { + c3_assert(pir_u->ext_u == 0); + pir_u->ent_u = 0; + } +} + +/* _pier_writ_dispose(): dispose of writ. +*/ +static void +_pier_writ_dispose(u3_writ* wit_u) +{ + /* free contents + */ + u3z(wit_u->job); + u3z(wit_u->mat); + u3z(wit_u->act); + + c3_free(wit_u); +} + +/* _pier_work_bail(): handle subprocess error. +*/ +static void +_pier_work_bail(void* vod_p, + const c3_c* err_c) +{ + fprintf(stderr, "pier: work error: %s\r\n", err_c); +} + +/* _pier_work_boot(): prepare for boot. +*/ +static void +_pier_work_boot(u3_pier* pir_u, c3_o sav_o) +{ + u3_controller* god_u = pir_u->god_u; + + c3_assert( 0 != pir_u->lif_d ); + + u3_noun who = u3i_chubs(2, pir_u->who_d); + u3_noun len = u3i_chubs(1, &pir_u->lif_d); + + if ( c3y == sav_o ) { + _pier_db_write_header(pir_u, who, u3k(pir_u->fak_o), len); + } + + u3_noun msg = u3nq(c3__boot, who, pir_u->fak_o, len); + u3_atom mat = u3ke_jam(msg); + u3_newt_write(&god_u->inn_u, mat, 0); +} + +/* _pier_work_shutdown(): stop the worker process. +*/ +static void +_pier_work_shutdown(u3_pier* pir_u) +{ + u3_controller* god_u = pir_u->god_u; + + u3_newt_write(&god_u->inn_u, u3ke_jam(u3nc(c3__exit, 0)), 0); +} + +/* _pier_work_build(): build atomic action. +*/ +static void +_pier_work_build(u3_writ* wit_u) +{ + /* marshal into atom + */ + if ( 0 == wit_u->mat ) { + c3_assert(0 != wit_u->job); + + wit_u->mat = u3ke_jam(u3nc(wit_u->mug_l, + u3k(wit_u->job))); + } +} + +/* _pier_work_send(): send to worker. +*/ +static void +_pier_work_send(u3_writ* wit_u) +{ + u3_pier* pir_u = wit_u->pir_u; + u3_controller* god_u = pir_u->god_u; + + c3_assert(0 != wit_u->mat); + + u3_noun msg = u3ke_jam(u3nt(c3__work, + u3i_chubs(1, &wit_u->evt_d), + u3k(wit_u->mat))); + + u3_newt_write(&god_u->inn_u, msg, wit_u); +} + +/* _pier_work_save(): tell worker to save checkpoint. +*/ +static void +_pier_work_save(u3_pier* pir_u) +{ + u3_controller* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; + u3_save* sav_u = pir_u->sav_u; + + c3_assert( god_u->dun_d == sav_u->req_d ); + c3_assert( log_u->com_d >= god_u->dun_d ); + + { + u3_noun mat = u3ke_jam(u3nc(c3__save, u3i_chubs(1, &god_u->dun_d))); + u3_newt_write(&god_u->inn_u, mat, 0); + + // XX wait on some report of success before updating? + // + sav_u->dun_d = sav_u->req_d; + } + + // if we're gracefully shutting down, do so now + // + if ( u3_psat_done == pir_u->sat_e ) { + _pier_exit_done(pir_u); + } +} + +/* _pier_work_release(): apply side effects. +*/ +static void +_pier_work_release(u3_writ* wit_u) +{ + u3_pier* pir_u = wit_u->pir_u; + u3_controller* god_u = pir_u->god_u; + u3_noun vir = wit_u->act; + + if ( u3_psat_pace == pir_u->sat_e ) { + fputc('.', stderr); + + // enqueue another batch of events for replay + // + { + u3_disk* log_u = pir_u->log_u; + + // XX requires that writs be unlinked before effects are released + // + if ( (0 == pir_u->ent_u) && + (wit_u->evt_d < log_u->com_d) ) + { + _pier_db_load_commits(pir_u, (1ULL + god_u->dun_d), 1000ULL); + } + } + } + else { +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): compute: release\r\n", wit_u->evt_d); +#endif + + // advance release counter + // + { + c3_assert(wit_u->evt_d == (1ULL + god_u->rel_d)); + god_u->rel_d += 1ULL; + } + + // apply actions + // + while ( u3_nul != vir ) { + u3_noun ovo, nex; + u3x_cell(vir, &ovo, &nex); + + u3_reck_kick(pir_u, u3k(ovo)); + vir = nex; + } + } + + // if we have completed the boot sequence, activate system events. + // + if ( wit_u->evt_d == pir_u->but_d ) { + _pier_boot_complete(pir_u); + } + + // take snapshot, if requested (and awaiting the commit of this event) + // + { + u3_save* sav_u = pir_u->sav_u; + + if ( (sav_u->req_d > sav_u->dun_d) && + (wit_u->evt_d == sav_u->req_d) ) + { + _pier_work_save(pir_u); + } + } +} + +/* _pier_work_complete(): worker reported completion. +*/ +static void +_pier_work_complete(u3_writ* wit_u, + c3_l mug_l, + u3_noun act) +{ + u3_pier* pir_u = wit_u->pir_u; + u3_controller* god_u = pir_u->god_u; + +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): compute: complete\r\n", wit_u->evt_d); +#endif + + god_u->dun_d += 1; + c3_assert(god_u->dun_d == wit_u->evt_d); + + god_u->mug_l = mug_l; + + c3_assert(wit_u->act == 0); + wit_u->act = act; + + if ( wit_u->evt_d > pir_u->lif_d ) { + u3_term_stop_spinner(); + } +} + +/* _pier_work_replace(): worker reported replacement. +*/ +static void +_pier_work_replace(u3_writ* wit_u, + u3_noun job) +{ + u3_pier* pir_u = wit_u->pir_u; + u3_controller* god_u = pir_u->god_u; + +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): compute: replace\r\n", wit_u->evt_d); +#endif + + c3_assert(god_u->sen_d == wit_u->evt_d); + + // something has gone very wrong, we should probably stop now + // + if ( wit_u->rep_d >= 3ULL ) { + u3_pier_bail(); + } + + /* move backward in work processing + */ + { + u3z(wit_u->job); + wit_u->job = job; + + u3z(wit_u->mat); + wit_u->mat = u3ke_jam(u3nc(wit_u->mug_l, + u3k(wit_u->job))); + + wit_u->rep_d += 1ULL; + + god_u->sen_d -= 1ULL; + } + + if ( wit_u->evt_d > pir_u->lif_d ) { + u3_term_stop_spinner(); + } +} + +/* _pier_work_compute(): dispatch for processing. +*/ +static void +_pier_work_compute(u3_writ* wit_u) +{ + u3_pier* pir_u = wit_u->pir_u; + u3_controller* god_u = pir_u->god_u; + +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): compute: request\r\n", wit_u->evt_d); +#endif + + c3_assert(wit_u->evt_d == (1 + god_u->sen_d)); + + wit_u->mug_l = god_u->mug_l; + + _pier_work_build(wit_u); + _pier_work_send(wit_u); + + god_u->sen_d += 1; + + if ( wit_u->evt_d > pir_u->lif_d ) { + u3_term_start_spinner(wit_u->job); + } +} + +/* _pier_work_play(): with active worker, create or load log. +*/ +static void +_pier_work_play(u3_pier* pir_u, + c3_d lav_d, + c3_l mug_l) +{ + u3_controller* god_u = pir_u->god_u; + +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: (%" PRIu64 "): boot at mug %x\r\n", lav_d, mug_l); +#endif + + c3_assert( c3n == god_u->liv_o ); + god_u->liv_o = c3y; + + // all events in the worker are complete + // + god_u->rel_d = god_u->dun_d = god_u->sen_d = (lav_d - 1ULL); + god_u->mug_l = mug_l; + + _pier_boot_ready(pir_u); +} + +/* _pier_work_stdr(): prints an error message to stderr + */ +static void +_pier_work_stdr(u3_writ* wit_u, u3_noun cord) +{ + c3_c* str = u3r_string(cord); + u3C.stderr_log_f(str); + free(str); +} + +/* _pier_work_slog(): print directly. +*/ +static void +_pier_work_slog(u3_writ* wit_u, c3_w pri_w, u3_noun tan) +{ +#ifdef U3_EVENT_TIME_DEBUG + { + static int old; + static struct timeval b4, f2, d0; + static c3_d b4_d; + c3_w ms_w; + + if ( old ) { + gettimeofday(&f2, 0); + timersub(&f2, &b4, &d0); + ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); + if (ms_w > 1) { + #if 0 + fprintf(stderr, "%6d.%02dms: %9d ", + ms_w, (int) (d0.tv_usec % 1000) / 10, + ((int) (u3R->pro.nox_d - b4_d))); + #else + fprintf(stderr, "%6d.%02dms ", + ms_w, (int) (d0.tv_usec % 1000) / 10); + #endif + gettimeofday(&b4, 0); + b4_d = u3R->pro.nox_d; + } + else { + fprintf(stderr, " "); + } + } + else { + gettimeofday(&b4, 0); + b4_d = u3R->pro.nox_d; + } + old = 1; + } +#endif + + switch ( pri_w ) { + case 3: fprintf(stderr, ">>> "); break; + case 2: fprintf(stderr, ">> "); break; + case 1: fprintf(stderr, "> "); break; + } + + u3_pier_tank(0, tan); +} + +/* _pier_work_exit(): handle subprocess exit. +*/ +static void +_pier_work_exit(uv_process_t* req_u, + c3_ds sas_i, + c3_i sig_i) +{ + u3_controller* god_u = (void *) req_u; + u3_pier* pir_u = god_u->pir_u; + + u3l_log("pier: exit: status %" PRIu64 ", signal %d\r\n", sas_i, sig_i); + uv_close((uv_handle_t*) req_u, 0); + + _pier_db_shutdown(pir_u); + _pier_work_shutdown(pir_u); +} + +/* _pier_work_poke(): handle subprocess result. transfer nouns. +*/ +static void +_pier_work_poke(void* vod_p, + u3_noun mat) +{ + u3_pier* pir_u = vod_p; + u3_noun jar = u3ke_cue(u3k(mat)); + u3_noun p_jar, q_jar, r_jar; + + if ( c3y != u3du(jar) ) { + goto error; + } + + switch ( u3h(jar) ) { + default: goto error; + + // the worker process starts with a %play task, + // which tells us where to start playback + // (and who we are, if it knows) XX remove in favor of event-log header + // + case c3__play: { + c3_d lav_d; + c3_l mug_l; + + if ( (c3n == u3r_qual(u3t(jar), 0, &p_jar, &q_jar, &r_jar)) || + (c3n == u3ud(p_jar)) || + (u3r_met(6, p_jar) != 1) || + (c3n == u3ud(q_jar)) || + (u3r_met(5, p_jar) != 1) || + (c3n == u3du(r_jar)) || + (c3n == u3ud(u3h(r_jar))) || + ((c3y != u3t(r_jar)) && (c3n != u3t(r_jar))) ) + { + if ( u3_nul == u3t(jar) ) { + lav_d = 1ULL; + mug_l = 0; + } + else { + goto error; + } + } + + if ( u3_nul != u3t(jar) ) { + lav_d = u3r_chub(0, p_jar); + mug_l = u3r_word(0, q_jar); + + // single-home + // + _pier_boot_set_ship(pir_u, u3k(u3h(r_jar)), u3k(u3t(r_jar))); + } + + _pier_work_play(pir_u, lav_d, mug_l); + break; + } + + case c3__work: { + if ( (c3n == u3r_trel(jar, 0, &p_jar, &q_jar)) || + (c3n == u3ud(p_jar)) || + (u3r_met(6, p_jar) != 1) ) + { + u3l_log("failed to parse replacement atom"); + goto error; + } + else { + c3_d evt_d = u3r_chub(0, p_jar); + u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); + + u3_noun mug, job; + u3_noun entry = u3ke_cue(u3k(q_jar)); + if ( (c3y != u3du(entry)) || + (c3n == u3r_cell(entry, &mug, &job)) || + (c3n == u3ud(mug)) || + (1 < u3r_met(5, mug)) ) { + goto error; + } + + c3_l mug_l = u3r_word(0, mug); + if ( !wit_u || (mug_l && (mug_l != wit_u->mug_l)) ) { + goto error; + } +#ifdef VERBOSE_EVENTS + fprintf(stderr, "pier: replace: %" PRIu64 "\r\n", evt_d); +#endif + + _pier_work_replace(wit_u, u3k(job)); + } + break; + } + + case c3__done: { + if ( (c3n == u3r_qual(jar, 0, &p_jar, &q_jar, &r_jar)) || + (c3n == u3ud(p_jar)) || + (u3r_met(6, p_jar) != 1) || + (c3n == u3ud(q_jar)) || + (u3r_met(5, q_jar) > 1) ) + { + goto error; + } + else { + c3_d evt_d = u3r_chub(0, p_jar); + c3_l mug_l = u3r_word(0, q_jar); + u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); + + if ( !wit_u ) { + u3l_log("poke: no writ: %" PRIu64 "\r\n", evt_d); + goto error; + } + _pier_work_complete(wit_u, mug_l, u3k(r_jar)); + } + break; + } + + case c3__stdr: { + if ( (c3n == u3r_trel(jar, 0, &p_jar, &q_jar)) || + (c3n == u3ud(p_jar)) || + (u3r_met(6, p_jar) > 1) || + (c3n == u3ud(q_jar)) ) + { + goto error; + } + else { + c3_d evt_d = u3r_chub(0, p_jar); + u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); + + // Unlike slog, we always reprint interpreter errors during replay. + _pier_work_stdr(wit_u, q_jar); + } + break; + } + + case c3__slog: { + if ( (c3n == u3r_qual(jar, 0, &p_jar, &q_jar, &r_jar)) || + (c3n == u3ud(p_jar)) || + (u3r_met(6, p_jar) != 1) || + (c3n == u3ud(q_jar)) || + (u3r_met(3, q_jar) > 1) ) + { + goto error; + } + else { + c3_d evt_d = u3r_chub(0, p_jar); + c3_w pri_w = u3r_word(0, q_jar); + u3_writ* wit_u = _pier_writ_find(pir_u, evt_d); + + // skip slog during replay + // + // XX also update the worker to skip *sending* the slog during replay + // + if ( u3_psat_pace != pir_u->sat_e ) { + _pier_work_slog(wit_u, pri_w, u3k(r_jar)); + } + } + break; + } + } + + u3z(jar); u3z(mat); + _pier_loop_resume(pir_u); + return; + + error: { + u3z(jar); u3z(mat); + _pier_work_bail(0, "bad jar"); + } +} + +/* pier_work_create(): instantiate child process. +*/ +static u3_controller* +_pier_work_create(u3_pier* pir_u) +{ + u3_controller* god_u = c3_calloc(sizeof *god_u); + + pir_u->god_u = god_u; + god_u->pir_u = pir_u; + god_u->liv_o = c3n; + + /* spawn new process and connect to it + */ + { + c3_c* arg_c[5]; + c3_c* bin_c = u3_Host.wrk_c; + c3_c* pax_c; + c3_c key_c[256]; + c3_c wag_c[11]; + c3_i err_i; + + pax_c = c3_malloc(1 + strlen(pir_u->pax_c)); + strcpy(pax_c, pir_u->pax_c); + + sprintf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", + pir_u->key_d[0], + pir_u->key_d[1], + pir_u->key_d[2], + pir_u->key_d[3]); + + sprintf(wag_c, "%u", pir_u->wag_w); + + arg_c[0] = bin_c; // executable + arg_c[1] = pax_c; // path to checkpoint directory + arg_c[2] = key_c; // disk key + arg_c[3] = wag_c; // runtime config + arg_c[4] = 0; + + uv_pipe_init(u3L, &god_u->inn_u.pyp_u, 0); + uv_pipe_init(u3L, &god_u->out_u.pyp_u, 0); + + god_u->cod_u[0].flags = UV_CREATE_PIPE | UV_READABLE_PIPE; + god_u->cod_u[0].data.stream = (uv_stream_t *)&god_u->inn_u; + + god_u->cod_u[1].flags = UV_CREATE_PIPE | UV_WRITABLE_PIPE; + god_u->cod_u[1].data.stream = (uv_stream_t *)&god_u->out_u; + + god_u->cod_u[2].flags = UV_INHERIT_FD; + god_u->cod_u[2].data.fd = 2; + + god_u->ops_u.stdio = god_u->cod_u; + god_u->ops_u.stdio_count = 3; + + god_u->ops_u.exit_cb = _pier_work_exit; + god_u->ops_u.file = arg_c[0]; + god_u->ops_u.args = arg_c; + + if ( (err_i = uv_spawn(u3L, &god_u->cub_u, &god_u->ops_u)) ) { + fprintf(stderr, "spawn: %s: %s\r\n", arg_c[0], uv_strerror(err_i)); + + return 0; + } + } + + /* start reading from proc + */ + { + god_u->out_u.vod_p = pir_u; + god_u->out_u.pok_f = _pier_work_poke; + god_u->out_u.bal_f = _pier_work_bail; + + god_u->inn_u.bal_f = _pier_work_bail; + + u3_newt_read(&god_u->out_u); + } + return god_u; +} + +/* _pier_loop_time(): set time. +*/ +static void +_pier_loop_time(void) +{ + struct timeval tim_tv; + + gettimeofday(&tim_tv, 0); + u3v_time(u3_time_in_tv(&tim_tv)); +} + +/* _pier_loop_prepare(): run on every loop iteration before i/o polling. +*/ +static void +_pier_loop_prepare(uv_prepare_t* pep_u) +{ + _pier_loop_time(); +} + +/* _pier_loop_idle_cb(): run on every loop iteration after i/o polling. +*/ +static void +_pier_loop_idle_cb(uv_idle_t* idl_u) +{ + u3_pier* pir_u = idl_u->data; + _pier_apply(pir_u); + + uv_idle_stop(idl_u); +} + +/* _pier_loop_resume(): (re-)activate idle handler +*/ +static void +_pier_loop_resume(u3_pier* pir_u) +{ + if ( !uv_is_active((uv_handle_t*)&pir_u->idl_u) ) { + uv_idle_start(&pir_u->idl_u, _pier_loop_idle_cb); + } +} + +/* _pier_loop_init_pier(): initialize loop handlers. +*/ +static void +_pier_loop_init(u3_pier* pir_u) +{ + c3_l cod_l; + + _pier_loop_time(); + + // for i/o drivers that still use u3A->sen + // + u3v_numb(); + + cod_l = u3a_lush(c3__ames); + u3_ames_io_init(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__behn); + u3_behn_io_init(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__unix); + u3_unix_io_init(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__save); + u3_save_io_init(pir_u); + u3a_lop(cod_l); + + // XX legacy handlers, not yet scoped to a pier + // + { + cod_l = u3a_lush(c3__term); + u3_term_io_init(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__http); + u3_http_io_init(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__cttp); + u3_cttp_io_init(); + u3a_lop(cod_l); + } +} + +/* _pier_loop_wake(): initialize listeners and send initial events. +*/ +static void +_pier_loop_wake(u3_pier* pir_u) +{ + c3_l cod_l; + + // inject fresh entropy + // + { + c3_w eny_w[16]; + c3_rand(eny_w); + + u3_noun wir = u3nt(u3_blip, c3__arvo, u3_nul); + u3_noun car = u3nc(c3__wack, u3i_words(16, eny_w)); + + u3_pier_work(pir_u, wir, car); + } + + cod_l = u3a_lush(c3__unix); + u3_unix_io_talk(pir_u); + u3_unix_ef_bake(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__ames); + u3_ames_io_talk(pir_u); + u3_ames_ef_bake(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__behn); + u3_behn_ef_bake(pir_u); + u3a_lop(cod_l); + + // XX legacy handlers, not yet scoped to a pier + // + { + cod_l = u3a_lush(c3__http); + u3_http_io_talk(); + u3_http_ef_bake(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__term); + u3_term_io_talk(); + u3_term_ef_bake(); + u3a_lop(cod_l); + } +} + +/* _pier_loop_exit(): terminate I/O across the process. +*/ +static void +_pier_loop_exit(u3_pier* pir_u) +{ + c3_l cod_l; + + cod_l = u3a_lush(c3__unix); + u3_unix_io_exit(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__ames); + u3_ames_io_exit(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__save); + u3_save_io_exit(pir_u); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__behn); + u3_behn_io_exit(pir_u); + u3a_lop(cod_l); + + // XX legacy handlers, not yet scoped to a pier + // + { + cod_l = u3a_lush(c3__term); + u3_term_io_exit(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__http); + u3_http_io_exit(); + u3a_lop(cod_l); + + cod_l = u3a_lush(c3__cttp); + u3_cttp_io_exit(); + u3a_lop(cod_l); + } +} + +/* _pier_boot_set_ship(): +*/ +static void +_pier_boot_set_ship(u3_pier* pir_u, u3_noun who, u3_noun fak) +{ + c3_assert( c3y == u3ud(who) ); + c3_assert( (c3y == fak) || (c3n == fak) ); + + c3_o fak_o = fak; + c3_d who_d[2]; + + u3r_chubs(0, 2, who_d, who); + + c3_assert( ( (0 == pir_u->fak_o) && + (0 == pir_u->who_d[0]) && + (0 == pir_u->who_d[1]) ) || + ( (fak_o == pir_u->fak_o) && + (who_d[0] == pir_u->who_d[0]) && + (who_d[1] == pir_u->who_d[1]) ) ); + + pir_u->fak_o = fak_o; + pir_u->who_d[0] = who_d[0]; + pir_u->who_d[1] = who_d[1]; + + { + u3_noun how = u3dc("scot", 'p', u3k(who)); + + c3_free(pir_u->who_c); + pir_u->who_c = u3r_string(how); + u3z(how); + } + + // Disable networking for fake ships + // + if ( c3y == pir_u->fak_o ) { + u3_Host.ops_u.net = c3n; + } + + u3z(who); u3z(fak); +} + +/* _pier_boot_create(): create boot controller +*/ +static u3_boot* +_pier_boot_create(u3_pier* pir_u, u3_noun pil, u3_noun ven) +{ + u3_boot* bot_u = c3_calloc(sizeof(u3_boot)); + bot_u->pil = u3k(pil); + bot_u->ven = u3k(ven); + bot_u->pir_u = pir_u; + + return bot_u; +} + +/* _pier_boot_dispose(): dispose of boot controller +*/ +static void +_pier_boot_dispose(u3_boot* bot_u) +{ + u3_pier* pir_u = bot_u->pir_u; + + u3z(bot_u->pil); + u3z(bot_u->ven); + free(bot_u); + pir_u->bot_u = 0; +} + +/* _pier_boot_vent(): create and enqueue boot sequence +** +** per cgy: +** this new boot sequence is almost, but not quite, +** the right thing. see new arvo. +*/ +static void +_pier_boot_vent(u3_boot* bot_u) +{ + // bot: boot formulas + // mod: module ova + // use: userpace ova + // + u3_noun bot, mod, use; + u3_pier* pir_u = bot_u->pir_u; + + // extract boot formulas and module/userspace ova from pill + // + { + u3_noun pil_p, pil_q, pil_r; + u3_noun pro; + + c3_assert( c3y == u3du(bot_u->pil) ); + + if ( c3y == u3h(bot_u->pil) ) { + u3x_trel(bot_u->pil, 0, &pil_p, &pil_q); + } + else { + u3x_qual(bot_u->pil, 0, &pil_p, &pil_q, &pil_r); + } + + pro = u3m_soft(0, u3ke_cue, u3k(pil_p)); + + if ( 0 != u3h(pro) ) { + fprintf(stderr, "boot: failed: unable to parse pill\r\n"); + exit(1); + } + + u3x_trel(u3t(pro), &bot, &mod, &use); + u3k(bot); u3k(mod); u3k(use); + + // optionally replace filesystem in userspace + // + if ( c3y == u3h(bot_u->pil) ) { + if ( u3_nul != pil_q ) { + c3_w len_w = 0; + u3_noun ova = use; + u3_noun new = u3_nul; + u3_noun ovo; + + while ( u3_nul != ova ) { + ovo = u3h(ova); + + if ( c3__into == u3h(u3t(ovo)) ) { + c3_assert( 0 == len_w ); + len_w++; + ovo = u3k(u3t(pil_q)); + } + + new = u3nc(u3k(ovo), new); + ova = u3t(ova); + } + + c3_assert( 1 == len_w ); + + u3z(use); + use = u3kb_flop(new); + } + } + // prepend %lite module and userspace ova + // + else { + mod = u3kb_weld(u3k(pil_q), mod); + use = u3kb_weld(u3k(pil_r), use); + } + + u3z(pro); + } + + // prepend entropy to the module sequence + // + { + c3_w eny_w[16]; + c3_rand(eny_w); + + u3_noun wir = u3nt(u3_blip, c3__arvo, u3_nul); + u3_noun car = u3nc(c3__wack, u3i_words(16, eny_w)); + + mod = u3nc(u3nc(wir, car), mod); + } + + // prepend identity to the module sequence, setting single-home + // + { + u3_noun wir = u3nt(u3_blip, c3__arvo, u3_nul); + u3_noun car = u3nc(c3__whom, u3i_chubs(2, pir_u->who_d)); + + mod = u3nc(u3nc(wir, car), mod); + } + + // insert boot sequence directly + // + // Note that these are not ovum or (pair @da ovum) events, + // but raw nock formulas to be directly evaluated as the + // subject of the lifecycle formula [%2 [%0 3] %0 2]. + // All subsequent events will be (pair @da ovum). + // + { + u3_noun fol = bot; + + // initialize the boot barrier + // + // And the initial lifecycle boot barrier. + // + pir_u->but_d = u3kb_lent(u3k(fol)); + pir_u->lif_d = pir_u->but_d; + + while ( u3_nul != fol ) { + _pier_writ_insert(pir_u, 0, u3k(u3h(fol))); + fol = u3t(fol); + } + } + + // insert module events + // + { + u3_noun ova = mod; + // add to the boot barrier + // + pir_u->but_d += u3kb_lent(u3k(ova)); + + while ( u3_nul != ova ) { + _pier_writ_insert_ovum(pir_u, 0, u3k(u3h(ova))); + ova = u3t(ova); + } + } + + // insert legacy boot event + // + { + // XX do something about this wire + // XX route directly to %jael? + // + c3_assert( c3y == u3du(bot_u->ven) ); + + u3_noun wir = u3nq(u3_blip, c3__term, '1', u3_nul); + u3_noun car = u3nc(c3__boot, u3k(bot_u->ven)); + u3_noun ovo = u3nc(wir, car); + + _pier_writ_insert_ovum(pir_u, 0, ovo); + } + + // insert userspace events + // + // Currently just the initial filesystem + // + { + u3_noun ova = use; + + while ( u3_nul != ova ) { + _pier_writ_insert_ovum(pir_u, 0, u3k(u3h(ova))); + ova = u3t(ova); + } + } + + u3z(bot); u3z(mod); u3z(use); +} + +/* _pier_boot_complete(): start organic event flow on boot/reboot. +*/ +static void +_pier_boot_complete(u3_pier* pir_u) +{ + if ( u3_psat_init != pir_u->sat_e ) { + u3_pier_snap(pir_u); + } + + if ( u3_psat_boot == pir_u->sat_e ) { + fprintf(stderr, "pier: boot complete\r\n"); + } + else if ( u3_psat_pace == pir_u->sat_e ) { + fprintf(stderr, "\n\r---------------- playback complete----------------\r\n"); + } + + pir_u->sat_e = u3_psat_play; + + // the main course + // + _pier_loop_wake(pir_u); + + // XX where should this go? + // + { + if ( c3y == u3_Host.ops_u.veb ) { + u3_term_ef_verb(); + } + } +} + +/* _pier_boot_ready(): +*/ +static void +_pier_boot_ready(u3_pier* pir_u) +{ + u3_controller* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; + + c3_assert( u3_psat_init == pir_u->sat_e ); + + if ( ( 0 == god_u) || + ( 0 == log_u) || + (c3y != god_u->liv_o) || + (c3y != log_u->liv_o) ) + { + return; + } + + // mark all commits as released + // + god_u->rel_d = log_u->com_d; + + // set next expected event number + // + pir_u->gen_d = (1ULL + log_u->com_d); + + // boot + // + if ( 0 != pir_u->bot_u ) { + c3_assert( 0 == log_u->com_d ); + c3_assert( 0 == god_u->dun_d ); + + // construct/enqueue boot sequence + // + _pier_boot_vent(pir_u->bot_u); + _pier_boot_dispose(pir_u->bot_u); + + // prepare worker for boot sequence, write log header + // + _pier_work_boot(pir_u, c3y); + + fprintf(stderr, "boot: ship: %s%s\r\n", + pir_u->who_c, + (c3y == pir_u->fak_o) ? " (fake)" : ""); + + pir_u->sat_e = u3_psat_boot; + } + // replay + // + else if ( god_u->dun_d < log_u->com_d ) { + c3_assert( 0 != log_u->com_d ); + + fprintf(stderr, "---------------- playback starting----------------\r\n"); + + // set the boot barrier to the last committed event + // + pir_u->but_d = log_u->com_d; + + // begin queuing batches of committed events + // + _pier_db_load_commits(pir_u, (1ULL + god_u->dun_d), 1000ULL); + + if ( 0 == god_u->dun_d ) { + fprintf(stderr, "pier: replaying events 1 through %" PRIu64 "\r\n", + log_u->com_d); + + // prepare worker for replay of boot sequence, don't write log header + // + _pier_work_boot(pir_u, c3n); + } + else { + fprintf(stderr, "pier: replaying events %" PRIu64 + " through %" PRIu64 "\r\n", + god_u->dun_d, + log_u->com_d); + } + + pir_u->sat_e = u3_psat_pace; + } + // resume + // + else { + c3_assert( 0 != log_u->com_d ); + c3_assert( 0 != god_u->dun_d ); + + // set the boot barrier to the last computed event + // + pir_u->but_d = god_u->dun_d; + + // resume normal operation + // + _pier_boot_complete(pir_u); + } +} + +/* _pier_apply(): react to i/o, inbound or outbound. +*/ +static void +_pier_apply(u3_pier* pir_u) +{ + u3_disk* log_u = pir_u->log_u; + u3_controller* god_u = pir_u->god_u; + u3_save* sav_u = pir_u->sav_u; + + if ( (0 == log_u) || + (0 == god_u) || + (c3n == god_u->liv_o) || + (u3_psat_init == pir_u->sat_e) ) + { + return; + } + + u3_writ* wit_u; + c3_o act_o = c3n; + +start: + + /* iterate from queue exit, advancing any writs that can advance + */ + wit_u = pir_u->ext_u; + while ( wit_u ) { + /* if writ is (a) next in line to compute, (b) worker is inactive, + ** and (c) a snapshot has not been requested, request computation + */ + if ( (wit_u->evt_d == (1 + god_u->sen_d)) && + (god_u->sen_d == god_u->dun_d) && + (sav_u->dun_d == sav_u->req_d) ) + { + _pier_work_compute(wit_u); + act_o = c3y; + } + + /* if writ is (a) computed and (b) next in line to commit, + ** and (c) no commit is in progress and (d) we've booted, + ** request commit. + */ + if ( (wit_u->evt_d <= god_u->dun_d) && + (wit_u->evt_d == (1 + log_u->moc_d)) && + (wit_u->evt_d == (1 + log_u->com_d)) ) + { + c3_d count = 1 + (god_u->dun_d - wit_u->evt_d); + struct u3_lmdb_write_request* request = + u3_lmdb_build_write_request(wit_u, count); + c3_assert(request != 0); + + _pier_db_commit_request(pir_u, + request, + wit_u->evt_d, + count); + act_o = c3y; + } + + /* if writ is (a) committed and (b) computed, + ** release effects and delete from queue + */ + if ( (wit_u->evt_d <= log_u->com_d) && + (wit_u->evt_d <= god_u->dun_d) ) + { + // effects must be released in order + // + c3_assert(wit_u == pir_u->ext_u); + + // remove from queue + // + // Must be done before releasing effects + // + _pier_writ_unlink(wit_u); + + // release effects + // + _pier_work_release(wit_u); + + // free writ + // + _pier_writ_dispose(wit_u); + + wit_u = pir_u->ext_u; + act_o = c3y; + } + else { + /* otherwise, continue backward + */ + wit_u = wit_u->nex_u; + } + } + + /* if we did anything to the queue, make another pass. + */ + if ( c3y == act_o ) { + act_o = c3n; + goto start; + } +} + +/* _pier_create(): create a pier, loading existing. +*/ +static u3_pier* +_pier_create(c3_w wag_w, c3_c* pax_c) +{ + // create pier + // + u3_pier* pir_u = c3_calloc(sizeof *pir_u); + + pir_u->pax_c = pax_c; + pir_u->wag_w = wag_w; + pir_u->sat_e = u3_psat_init; + + pir_u->sam_u = c3_calloc(sizeof(u3_ames)); + pir_u->teh_u = c3_calloc(sizeof(u3_behn)); + pir_u->unx_u = c3_calloc(sizeof(u3_unix)); + pir_u->sav_u = c3_calloc(sizeof(u3_save)); + + // initialize persistence + // + if ( c3n == _pier_disk_create(pir_u) ) { + return 0; + } + + // start the worker process + // + if ( !(pir_u->god_u = _pier_work_create(pir_u)) ) { + return 0; + } + + // install in the pier table + // + if ( 0 == u3K.all_w ) { + u3K.all_w = 16; + u3K.tab_u = c3_malloc(16 * sizeof(u3_pier*)); + } + if ( u3K.len_w == u3K.all_w ) { + u3K.all_w = 2 * u3K.all_w; + u3K.tab_u = c3_realloc(u3K.tab_u, u3K.all_w * sizeof(u3_pier*)); + } + u3K.tab_u[u3K.len_w++] = pir_u; + + return pir_u; +} + +/* u3_pier_interrupt(): interrupt running process. +*/ +void +u3_pier_interrupt(u3_pier* pir_u) +{ + uv_process_kill(&pir_u->god_u->cub_u, SIGINT); +} + +/* _pier_exit_done(): synchronously shutting down +*/ +static void +_pier_exit_done(u3_pier* pir_u) +{ + u3l_log("pier: exit\r\n"); + + _pier_db_shutdown(pir_u); + _pier_work_shutdown(pir_u); + _pier_loop_exit(pir_u); + + // XX uninstall pier from u3K.tab_u, dispose + + // XX no can do + // + uv_stop(u3L); +} + +/* u3_pier_exit(): trigger a gentle shutdown. +*/ +void +u3_pier_exit(u3_pier* pir_u) +{ + pir_u->sat_e = u3_psat_done; + + // XX must wait for callback confirming + // + u3_pier_snap(pir_u); +} + +/* u3_pier_snap(): request snapshot +*/ +void +u3_pier_snap(u3_pier* pir_u) +{ + u3_controller* god_u = pir_u->god_u; + u3_disk* log_u = pir_u->log_u; + u3_save* sav_u = pir_u->sav_u; + + c3_d top_d = c3_max(god_u->sen_d, god_u->dun_d); + + // no-op if there are no un-snapshot'ed events + // + if ( top_d > sav_u->dun_d ) { + sav_u->req_d = top_d; + + // save eagerly if all computed events are already committed + // + if ( (log_u->com_d >= top_d) && + (god_u->dun_d == top_d) ) { + _pier_work_save(pir_u); + } + } + // if we're gracefully shutting down, do so now + // + else if ( u3_psat_done == pir_u->sat_e ) { + _pier_exit_done(pir_u); + } +} + +/* u3_pier_discover(): insert task into process controller. +*/ +void +u3_pier_discover(u3_pier* pir_u, + c3_l msc_l, + u3_noun job) +{ + _pier_writ_insert(pir_u, msc_l, job); + _pier_loop_resume(pir_u); +} + +/* u3_pier_send(): modern send with target and path. +*/ +void +u3_pier_send(u3_pier* pir_u, u3_noun pax, u3_noun tag, u3_noun fav) +{ +} + +/* u3_pier_work(): send event; real pier pointer. +** +** XX: u3_pier_work() is for legacy events sent to a real pier. +*/ +void +u3_pier_work(u3_pier* pir_u, u3_noun pax, u3_noun fav) +{ + u3_noun now; + struct timeval tim_tv; + + gettimeofday(&tim_tv, 0); + now = u3_time_in_tv(&tim_tv); + + u3_pier_discover(pir_u, 0, u3nt(now, pax, fav)); +} + +/* u3_pier_plan(): send event; fake pier pointer +** +** XX: u3_pier_plan() is maximum legacy, do not use. +*/ +void +u3_pier_plan(u3_noun pax, u3_noun fav) +{ + u3_pier_work(u3_pier_stub(), pax, fav); +} + +/* c3_rand(): fill a 512-bit (16-word) buffer. +*/ +void +c3_rand(c3_w* rad_w) +{ + if ( 0 != ent_getentropy(rad_w, 64) ) { + u3l_log("c3_rand getentropy: %s\n", strerror(errno)); + // XX review + // + u3_pier_bail(); + } +} + +/* u3_pier_bail(): immediately shutdown. +*/ +void +u3_pier_bail(void) +{ + if ( 0 != u3K.len_w ) { + _pier_exit_done(u3_pier_stub()); + } + + fflush(stdout); + exit(1); +} + +/* _pier_tape(): dump a tape, old style. Don't do this. +*/ +static void +_pier_tape(FILE* fil_u, u3_noun tep) +{ + u3_noun tap = tep; + + while ( c3y == u3du(tap) ) { + c3_c car_c; + + if ( u3h(tap) >= 127 ) { + car_c = '?'; + } else car_c = u3h(tap); + + putc(car_c, fil_u); + tap = u3t(tap); + } + u3z(tep); +} + +/* _pier_wall(): dump a wall, old style. Don't do this. +*/ +static void +_pier_wall(u3_noun wol) +{ + FILE* fil_u = u3_term_io_hija(); + u3_noun wal = wol; + + // XX temporary, for urb.py test runner + // + if ( c3y == u3_Host.ops_u.dem ) { + fil_u = stderr; + } + + while ( u3_nul != wal ) { + _pier_tape(fil_u, u3k(u3h(wal))); + + putc(13, fil_u); + putc(10, fil_u); + + wal = u3t(wal); + } + u3_term_io_loja(0); + u3z(wol); +} + +/* u3_pier_tank(): dump single tank. +*/ +void +u3_pier_tank(c3_l tab_l, u3_noun tac) +{ + u3_pier_punt(tab_l, u3nc(tac, u3_nul)); +} + +/* u3_pier_punt(): dump tank list. +*/ +void +u3_pier_punt(c3_l tab_l, u3_noun tac) +{ + u3_noun blu = u3_term_get_blew(0); + c3_l col_l = u3h(blu); + u3_noun cat = tac; + + // We are calling nock here, but hopefully need no protection. + // + while ( c3y == u3r_du(cat) ) { + if ( 0 == u3A->roc ) { + u3_noun act = u3h(cat); + + if ( c3__leaf == u3h(act) ) { + FILE* fil_u = u3_term_io_hija(); + + // XX temporary, for urb.py test runner + // + if ( c3y == u3_Host.ops_u.dem ) { + fil_u = stderr; + } + + _pier_tape(fil_u, u3k(u3t(act))); + putc(13, fil_u); + putc(10, fil_u); + + u3_term_io_loja(0); + } + } + else { + u3_noun wol = u3dc("wash", u3nc(tab_l, col_l), u3k(u3h(cat))); + + _pier_wall(wol); + } + cat = u3t(cat); + } + u3z(tac); + u3z(blu); +} + +/* u3_pier_sway(): print trace. +*/ +void +u3_pier_sway(c3_l tab_l, u3_noun tax) +{ + u3_noun mok = u3dc("mook", 2, tax); + + u3_pier_punt(tab_l, u3k(u3t(mok))); + u3z(mok); +} + +/* u3_pier_stub(): get the One Pier for unreconstructed code. +*/ +u3_pier* +u3_pier_stub(void) +{ + if ( 0 == u3K.len_w ) { + c3_assert(!"plan: no pier"); + } + else { + return u3K.tab_u[0]; + } +} + +/* _pier_init(): initialize pier i/o handles +*/ +static void +_pier_init(u3_pier* pir_u) +{ + // initialize i/o handlers + // + _pier_loop_init(pir_u); + + // initialize pre i/o polling handle + // + uv_prepare_init(u3_Host.lup_u, &pir_u->pep_u); + pir_u->pep_u.data = pir_u; + uv_prepare_start(&pir_u->pep_u, _pier_loop_prepare); + + // initialize post i/o polling handle + // + uv_idle_init(u3_Host.lup_u, &pir_u->idl_u); + pir_u->idl_u.data = pir_u; + + _pier_loop_resume(pir_u); +} + +/* u3_pier_boot(): start the new pier system. +*/ +void +u3_pier_boot(c3_w wag_w, // config flags + u3_noun who, // identity + u3_noun ven, // boot event + u3_noun pil, // type-of/path-to pill + u3_noun pax) // path to pier +{ + // make/load pier + // + u3_pier* pir_u = _pier_create(wag_w, u3r_string(pax)); + + if ( 0 == pir_u ) { + u3l_log("pier: failed to create\r\n"); + u3_daemon_bail(); + exit(1); + } + + // set boot params + // + { + pir_u->bot_u = _pier_boot_create(pir_u, u3k(pil), u3k(ven)); + + _pier_boot_set_ship(pir_u, u3k(who), ( c3__fake == u3h(ven) ) ? c3y : c3n); + } + + _pier_init(pir_u); + + u3z(who); u3z(ven); u3z(pil); u3z(pax); +} + +/* u3_pier_stay(): resume the new pier system. +*/ +void +u3_pier_stay(c3_w wag_w, u3_noun pax) +{ + // make/load pier + // + u3_pier* pir_u = _pier_create(wag_w, u3r_string(pax)); + + if ( 0 == pir_u ) { + u3l_log("pier: failed to create\r\n"); + u3_daemon_bail(); + exit(1); + } + + _pier_init(pir_u); + + u3z(pax); +} + +/* u3_pier_mark(): mark all Loom allocations in all u3_pier structs. +*/ +c3_w +u3_pier_mark(FILE* fil_u) +{ + c3_w len_w = u3K.len_w; + c3_w tot_w = 0; + u3_pier* pir_u; + + while ( 0 < len_w ) { + pir_u = u3K.tab_u[--len_w]; + u3l_log("pier: %u\r\n", len_w); + + if ( 0 != pir_u->bot_u ) { + tot_w += u3a_maid(fil_u, " boot event", u3a_mark_noun(pir_u->bot_u->ven)); + tot_w += u3a_maid(fil_u, " pill", u3a_mark_noun(pir_u->bot_u->pil)); + } + + { + u3_writ* wit_u = pir_u->ent_u; + c3_w wit_w = 0; + + while ( 0 != wit_u ) { + wit_w += u3a_mark_noun(wit_u->job); + wit_w += u3a_mark_noun(wit_u->now); + wit_w += u3a_mark_noun(wit_u->mat); + wit_w += u3a_mark_noun(wit_u->act); + wit_u = wit_u->nex_u; + } + + tot_w += u3a_maid(fil_u, " writs", wit_w); + } + } + + return tot_w; +} diff --git a/pkg/hs/vere/notes/c/reck.c b/pkg/hs/vere/notes/c/reck.c new file mode 100644 index 000000000..ba803e36c --- /dev/null +++ b/pkg/hs/vere/notes/c/reck.c @@ -0,0 +1,482 @@ +/* vere/reck.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _reck_mole(): parse simple atomic mole. +*/ +static u3_noun +_reck_mole(u3_noun fot, + u3_noun san, + c3_d* ato_d) +{ + u3_noun uco = u3dc("slaw", fot, san); + u3_noun p_uco, q_uco; + + if ( (c3n == u3r_cell(uco, &p_uco, &q_uco)) || + (u3_nul != p_uco) ) + { + u3l_log("strange mole %s\n", u3r_string(san)); + + u3z(fot); u3z(uco); return c3n; + } + else { + *ato_d = u3r_chub(0, q_uco); + + u3z(fot); u3z(uco); return c3y; + } +} + +/* _reck_lily(): parse little atom. +*/ +static u3_noun +_reck_lily(u3_noun fot, u3_noun txt, c3_l* tid_l) +{ + c3_d ato_d; + + if ( c3n == _reck_mole(fot, txt, &ato_d) ) { + return c3n; + } else { + if ( ato_d >= 0x80000000ULL ) { + return c3n; + } else { + *tid_l = (c3_l) ato_d; + + return c3y; + } + } +} + +/* _reck_orchid(): parses only a number as text + * + * Parses a text string which contains a decimal number. In practice, this + * number is always '1'. + */ +static u3_noun +_reck_orchid(u3_noun fot, u3_noun txt, c3_l* tid_l) +{ + c3_c* str = u3r_string(txt); + c3_d ato_d = strtol(str, NULL, 10); + free(str); + + if ( ato_d >= 0x80000000ULL ) { + return c3n; + } else { + *tid_l = (c3_l) ato_d; + + return c3y; + } +} + +/* _reck_kick_term(): apply terminal outputs. +*/ +static u3_noun +_reck_kick_term(u3_pier* pir_u, u3_noun pox, c3_l tid_l, u3_noun fav) +{ + u3_noun p_fav; + + if ( c3n == u3du(fav) ) { + u3z(pox); u3z(fav); return c3n; + } + else switch ( u3h(fav) ) { + default: u3z(pox); u3z(fav); return c3n; + case c3__bbye: + { + u3z(pox); u3z(fav); return c3y; + } break; + + case c3__blit: p_fav = u3t(fav); + { + u3_term_ef_blit(tid_l, u3k(p_fav)); + + u3z(pox); u3z(fav); return c3y; + } break; + + // this can return through dill due to our fscked up boot sequence + // + case c3__send: { + u3_noun lan = u3k(u3h(u3t(fav))); + u3_noun pac = u3k(u3t(u3t(fav))); + + u3l_log("kick: strange send\r\n"); + u3_ames_ef_send(pir_u, lan, pac); + u3z(pox); u3z(fav); return c3y; + } break; + + case c3__logo: + { + u3_pier_exit(pir_u); + u3_Host.xit_i = u3t(fav); + + u3z(pox); u3z(fav); return c3y; + } break; + + case c3__init: p_fav = u3t(fav); + { + // daemon ignores %init + // u3A->own = u3nc(u3k(p_fav), u3A->own); + // u3l_log("kick: init: %d\n", p_fav); + u3z(pox); u3z(fav); return c3y; + } break; + + case c3__mass: p_fav = u3t(fav); + { + u3z(pox); u3z(fav); + + // gc the daemon area + // + uv_timer_start(&u3K.tim_u, (uv_timer_cb)u3_daemon_grab, 0, 0); + return c3y; + } break; + } + c3_assert(!"not reached"); return 0; +} + +/* _reck_kick_http(): apply http effects. +*/ +static u3_noun +_reck_kick_http(u3_pier* pir_u, + u3_noun pox, + c3_l sev_l, + c3_l coq_l, + c3_l seq_l, + u3_noun fav) +{ + u3_noun p_fav, q_fav; + + if ( c3n == u3du(fav) ) { + u3z(pox); u3z(fav); return c3n; + } + else switch ( u3h(fav) ) { + default: u3z(pox); u3z(fav); return c3n; + + case c3__form: p_fav = u3t(fav); + { + u3_http_ef_form(u3k(p_fav)); + + // The control server has now started. + // + // If we're in daemon mode, we need to inform the parent process + // that we've finished booting. + if (u3_Host.bot_f) { + u3_Host.bot_f(); + } + + u3z(pox); u3z(fav); + return c3y; + } + + case c3__that: p_fav = u3t(fav); + { + u3_http_ef_that(u3k(p_fav)); + + u3z(pox); u3z(fav); + return c3y; + } + + case c3__thus: p_fav = u3h(u3t(fav)); q_fav = u3t(u3t(fav)); + { + u3_cttp_ef_thus(u3r_word(0, p_fav), u3k(q_fav)); + + u3z(pox); u3z(fav); + return c3y; + } + case c3__thou: p_fav = u3t(fav); + { + u3_http_ef_thou(sev_l, coq_l, seq_l, u3k(p_fav)); + + u3z(pox); u3z(fav); + return c3y; + } break; + } + c3_assert(!"not reached"); return c3n; +} + +/* _reck_kick_behn(): apply packet network outputs. +*/ +static u3_noun +_reck_kick_behn(u3_pier* pir_u, u3_noun pox, u3_noun fav) +{ + switch ( u3h(fav) ) { + default: break; + + case c3__doze: { + u3_behn_ef_doze(pir_u, u3k(u3t(fav))); + u3z(pox); u3z(fav); return c3y; + } break; + } + u3z(pox); u3z(fav); return c3n; +} + +/* _reck_kick_sync(): apply sync outputs. +*/ +static u3_noun +_reck_kick_sync(u3_pier* pir_u, u3_noun pox, u3_noun fav) +{ + switch ( u3h(fav) ) { + default: break; + case c3__dirk: { + u3_unix_ef_dirk(pir_u, u3k(u3t(fav))); + u3z(pox); u3z(fav); return c3y; + } + case c3__ergo: { + u3_noun mon = u3k(u3h(u3t(fav))); + u3_noun can = u3k(u3t(u3t(fav))); + + u3_unix_ef_ergo(pir_u, mon, can); + u3z(pox); u3z(fav); return c3y; + } break; + case c3__ogre: { + u3_unix_ef_ogre(pir_u, u3k(u3t(fav))); + u3z(pox); u3z(fav); return c3y; + } + case c3__hill: { + u3_unix_ef_hill(pir_u, u3k(u3t(fav))); + u3z(pox); u3z(fav); return c3y; + } + } + + // XX obviously not right! + // ? looks fine to me + u3z(pox); u3z(fav); return c3n; +} + +/* _reck_kick_newt(): apply packet network outputs. +*/ +static u3_noun +_reck_kick_newt(u3_pier* pir_u, u3_noun pox, u3_noun fav) +{ + switch ( u3h(fav) ) { + default: break; + case c3__send: { + u3_noun lan = u3k(u3h(u3t(fav))); + u3_noun pac = u3k(u3t(u3t(fav))); + + u3_ames_ef_send(pir_u, lan, pac); + u3z(pox); u3z(fav); return c3y; + } break; + + case c3__turf: { + u3_ames_ef_turf(pir_u, u3k(u3t(fav))); + u3z(pox); u3z(fav); return c3y; + } break; + + } + u3z(pox); u3z(fav); return c3n; +} + +/* _reck_kick_ames(): apply packet network outputs. +*/ +static u3_noun +_reck_kick_ames(u3_pier* pir_u, u3_noun pox, u3_noun fav) +{ + u3_noun p_fav; + + switch ( u3h(fav) ) { + default: break; + case c3__init: p_fav = u3t(fav); + { + // daemon ignores %init + // u3A->own = u3nc(u3k(p_fav), u3A->own); + // u3l_log("kick: init: %d\n", p_fav); + u3z(pox); u3z(fav); return c3y; + } break; + } + u3z(pox); u3z(fav); return c3n; +} + +/* _reck_kick_spec(): apply an effect, by path. +*/ +static u3_noun +_reck_kick_spec(u3_pier* pir_u, u3_noun pox, u3_noun fav) +{ + u3_noun i_pox, t_pox; + + if ( (c3n == u3r_cell(pox, &i_pox, &t_pox)) || + ((i_pox != u3_blip) && + (i_pox != c3__gold) && + (i_pox != c3__iron) && + (i_pox != c3__lead)) ) + { + u3z(pox); u3z(fav); return c3n; + } else { + u3_noun it_pox, tt_pox; + + if ( (c3n == u3r_cell(t_pox, &it_pox, &tt_pox)) ) { + u3z(pox); u3z(fav); return c3n; + } + else switch ( it_pox ) { + default: u3z(pox); u3z(fav); return c3n; + + case c3__http: { + u3_noun pud = tt_pox; + u3_noun p_pud, t_pud, tt_pud, q_pud, r_pud, s_pud; + c3_l sev_l, coq_l, seq_l; + + if ( (c3n == u3r_cell(pud, &p_pud, &t_pud)) || + (c3n == _reck_lily(c3__uv, u3k(p_pud), &sev_l)) ) + { + u3z(pox); u3z(fav); return c3n; + } + + if ( u3_nul == t_pud ) { + coq_l = seq_l = 0; + } + else { + if ( (c3n == u3r_cell(t_pud, &q_pud, &tt_pud)) || + (c3n == _reck_lily(c3__ud, u3k(q_pud), &coq_l)) ) + { + u3z(pox); u3z(fav); return c3n; + } + + if ( u3_nul == tt_pud ) { + seq_l = 0; + } else { + if ( (c3n == u3r_cell(tt_pud, &r_pud, &s_pud)) || + (u3_nul != s_pud) || + (c3n == _reck_lily(c3__ud, u3k(r_pud), &seq_l)) ) + { + u3z(pox); u3z(fav); return c3n; + } + } + } + return _reck_kick_http(pir_u, pox, sev_l, coq_l, seq_l, fav); + } break; + + case c3__behn: { + return _reck_kick_behn(pir_u, pox, fav); + } break; + + case c3__clay: + case c3__boat: + case c3__sync: { + return _reck_kick_sync(pir_u, pox, fav); + } break; + + case c3__newt: { + return _reck_kick_newt(pir_u, pox, fav); + } break; + + case c3__ames: { + if ( (u3_nul != tt_pox) ) { + u3z(pox); u3z(fav); return c3n; + } + else { + return _reck_kick_ames(pir_u, pox, fav); + } + } break; + + case c3__init: { + // daemon ignores %init + // p_fav = u3t(fav); + // u3A->own = u3nc(u3k(p_fav), u3A->own); + // u3l_log("kick: init: %d\n", p_fav); + u3z(pox); u3z(fav); return c3y; + } break; + + case c3__term: { + u3_noun pud = tt_pox; + u3_noun p_pud, q_pud; + c3_l tid_l; + + if ( (c3n == u3r_cell(pud, &p_pud, &q_pud)) || + (u3_nul != q_pud) || + (c3n == _reck_orchid(c3__ud, u3k(p_pud), &tid_l)) ) + { + u3l_log("term: bad tire\n"); + u3z(pox); u3z(fav); return c3n; + } else { + return _reck_kick_term(pir_u, pox, tid_l, fav); + } + } break; + } + } + c3_assert(!"not reached"); + return c3n; +} + +/* _reck_kick_norm(): non path-specific effect handling. +*/ +static u3_noun +_reck_kick_norm(u3_pier* pir_u, u3_noun pox, u3_noun fav) +{ + if ( c3n == u3du(fav) ) { + u3z(pox); u3z(fav); return c3n; + } + else switch ( u3h(fav) ) { + default: u3z(pox); u3z(fav); return c3n; + + case c3__vega: + { + u3l_log("<<>>\n"); + u3z(pox); u3z(fav); + + // reclaim memory from persistent caches + // + u3m_reclaim(); + + return c3y; + } + case c3__exit: + { + u3l_log("<<>>\n"); + u3_pier_exit(pir_u); + + u3z(pox); u3z(fav); return c3y; + } break; + } + c3_assert(!"not reached"); return c3n; + u3z(pox); u3z(fav); return c3n; +} + +/* u3_reck_kick(): handle effect. +*/ +void +u3_reck_kick(u3_pier* pir_u, u3_noun ovo) +{ + if ( (c3n == _reck_kick_spec(pir_u, u3k(u3h(ovo)), u3k(u3t(ovo)))) && + (c3n == _reck_kick_norm(pir_u, u3k(u3h(ovo)), u3k(u3t(ovo)))) ) + { +#if 0 + if ( (c3__warn != u3h(u3t(ovo))) && + (c3__text != u3h(u3t(ovo))) && + (c3__note != u3h(u3t(ovo))) ) +#endif +#if 1 + if ( (c3__crud == u3h(u3t(ovo))) ) +#if 0 + (c3__talk == u3h(u3t(ovo))) || + (c3__helo == u3h(u3t(ovo))) || + (c3__init == u3h(u3t(ovo))) ) +#endif + { + u3_pier_work(pir_u, + u3nt(u3_blip, c3__term, u3_nul), + u3nc(c3__flog, u3k(u3t(ovo)))); + } + else { + u3_noun tox = u3do("spat", u3k(u3h(ovo))); + u3l_log("kick: lost %%%s on %s\n", + u3r_string(u3h(u3t(ovo))), + u3r_string(tox)); + u3z(tox); +#if 0 + if ( c3__hear == u3h(u3t(ovo)) ) { + c3_assert(0); + } +#endif + } +#endif + } + u3z(ovo); +} diff --git a/pkg/hs/vere/notes/c/save.c b/pkg/hs/vere/notes/c/save.c new file mode 100644 index 000000000..1c62e8442 --- /dev/null +++ b/pkg/hs/vere/notes/c/save.c @@ -0,0 +1,66 @@ +/* vere/save.c +** +*/ +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* _save_time_cb(): timer callback. +*/ +static void +_save_time_cb(uv_timer_t* tim_u) +{ + u3_pier *pir_u = tim_u->data; + u3_pier_snap(pir_u); +} + +/* u3_save_ef_chld(): report save termination. +*/ +void +u3_save_ef_chld(u3_pier *pir_u) +{ + u3_save* sav_u = pir_u->sav_u; + c3_i loc_i; + c3_w pid_w; + + /* modified for cases with no pid_w + */ + u3l_log("checkpoint: complete %d\n", sav_u->pid_w); + pid_w = wait(&loc_i); + if (0 != sav_u->pid_w) { + c3_assert(pid_w == sav_u->pid_w); + } + else { + c3_assert(pid_w > 0); + } + sav_u->pid_w = 0; +} + +/* u3_save_io_init(): initialize autosave. +*/ +void +u3_save_io_init(u3_pier *pir_u) +{ + u3_save* sav_u = pir_u->sav_u; + + sav_u->req_d = 0; + sav_u->dun_d = 0; + sav_u->pid_w = 0; + + sav_u->tim_u.data = pir_u; + uv_timer_init(u3L, &sav_u->tim_u); + uv_timer_start(&sav_u->tim_u, _save_time_cb, 120000, 120000); +} + +/* u3_save_io_exit(): terminate save I/O. +*/ +void +u3_save_io_exit(u3_pier *pir_u) +{ +} diff --git a/pkg/hs/vere/notes/c/term.c b/pkg/hs/vere/notes/c/term.c new file mode 100644 index 000000000..868a33c53 --- /dev/null +++ b/pkg/hs/vere/notes/c/term.c @@ -0,0 +1,1342 @@ +/* vere/term.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +static void _term_spinner_cb(void*); +static void _term_read_cb(uv_stream_t* tcp_u, + ssize_t siz_i, + const uv_buf_t * buf_u); +static inline void _term_suck(u3_utty*, const c3_y*, ssize_t); +static u3_utty* _term_main(); + +#define _SPIN_COOL_US 500000 // spinner activation delay when cool +#define _SPIN_WARM_US 50000 // spinner activation delay when warm +#define _SPIN_RATE_US 250000 // spinner rate (microseconds/frame) +#define _SPIN_IDLE_US 500000 // spinner cools down if stopped this long + +static void _write(int fd, const void *buf, size_t count) +{ + if (count != write(fd, buf, count)){ + u3l_log("write failed\r\n"); + c3_assert(0); + } +} + + +/* _term_msc_out_host(): unix microseconds from current host time. +*/ +static c3_d +_term_msc_out_host() +{ + struct timeval tim_tv; + gettimeofday(&tim_tv, 0); + return 1000000ULL * tim_tv.tv_sec + tim_tv.tv_usec; +} + +/* _term_alloc(): libuv buffer allocator. +*/ +static void +_term_alloc(uv_handle_t* had_u, + size_t len_i, + uv_buf_t* buf + ) +{ + // this read can range from a single byte to a paste buffer + // 123 bytes has been chosen because its not a power of 2 + // this is probably still broken + // + void* ptr_v = c3_malloc(123); + *buf = uv_buf_init(ptr_v, 123); +} + + +// XX unused, but %hook is in %zuse. +// implement or remove +// +#if 0 +/* _term_close_cb(): free terminal. +*/ +static void +_term_close_cb(uv_handle_t* han_t) +{ + u3_utty* tty_u = (void*) han_t; + if ( u3_Host.uty_u == tty_u ) { + u3_Host.uty_u = tty_u->nex_u; + } + else { + u3_utty* uty_u; + for (uty_u = u3_Host.uty_u; uty_u; uty_u = uty_u->nex_u ) { + if ( uty_u->nex_u == tty_u ) { + uty_u->nex_u = tty_u->nex_u; + break; + } + } + } + + { + u3_noun tid = u3dc("scot", c3__ud, tty_u->tid_l); + u3_noun pax = u3nq(u3_blip, c3__term, tid, u3_nul); + u3_pier_plan(u3k(pax), u3nc(c3__hook, u3_nul)); + u3z(pax); + } + free(tty_u); +} +#endif + +/* u3_term_io_init(): initialize terminal. +*/ +void +u3_term_io_init() +{ + u3_utty* uty_u = c3_calloc(sizeof(u3_utty)); + + if ( c3y == u3_Host.ops_u.dem ) { + uty_u->fid_i = 1; + + uv_pipe_init(u3L, &(uty_u->pop_u), 0); + uv_pipe_open(&(uty_u->pop_u), uty_u->fid_i); + } + else { + // Initialize event processing. Rawdog it. + // + { + uty_u->fid_i = 0; // stdin, yes we write to it... + + uv_pipe_init(u3L, &(uty_u->pop_u), 0); + uv_pipe_open(&(uty_u->pop_u), uty_u->fid_i); + uv_read_start((uv_stream_t*)&(uty_u->pop_u), _term_alloc, _term_read_cb); + } + + // Configure horrible stateful terminfo api. + // + { + if ( 0 != setupterm(0, 2, 0) ) { + c3_assert(!"init-setupterm"); + } + } + + // Load terminfo strings. + // + { + c3_w len_w; + +# define _utfo(way, nam) \ + { \ + uty_u->ufo_u.way.nam##_y = (const c3_y *) tigetstr(#nam); \ + c3_assert(uty_u->ufo_u.way.nam##_y); \ + } + + uty_u->ufo_u.inn.max_w = 0; + + _utfo(inn, kcuu1); + _utfo(inn, kcud1); + _utfo(inn, kcub1); + _utfo(inn, kcuf1); + + _utfo(out, clear); + _utfo(out, el); + // _utfo(out, el1); + _utfo(out, ed); + _utfo(out, bel); + _utfo(out, cub1); + _utfo(out, cuf1); + _utfo(out, cuu1); + _utfo(out, cud1); + // _utfo(out, cub); + // _utfo(out, cuf); + + // Terminfo chronically reports the wrong sequence for arrow + // keys on xterms. Drastic fix for ridiculous unacceptable bug. + // Yes, we could fix this with smkx/rmkx, but this is retarded as well. + { + uty_u->ufo_u.inn.kcuu1_y = (const c3_y*)"\033[A"; + uty_u->ufo_u.inn.kcud1_y = (const c3_y*)"\033[B"; + uty_u->ufo_u.inn.kcuf1_y = (const c3_y*)"\033[C"; + uty_u->ufo_u.inn.kcub1_y = (const c3_y*)"\033[D"; + } + + uty_u->ufo_u.inn.max_w = 0; + if ( (len_w = strlen((c3_c*)uty_u->ufo_u.inn.kcuu1_y)) > + uty_u->ufo_u.inn.max_w ) + { + uty_u->ufo_u.inn.max_w = len_w; + } + if ( (len_w = strlen((c3_c*)uty_u->ufo_u.inn.kcud1_y)) > + uty_u->ufo_u.inn.max_w ) + { + uty_u->ufo_u.inn.max_w = len_w; + } + if ( (len_w = strlen((c3_c*)uty_u->ufo_u.inn.kcub1_y)) > + uty_u->ufo_u.inn.max_w ) + { + uty_u->ufo_u.inn.max_w = len_w; + } + if ( (len_w = strlen((c3_c*)uty_u->ufo_u.inn.kcuf1_y)) > + uty_u->ufo_u.inn.max_w ) + { + uty_u->ufo_u.inn.max_w = len_w; + } + } + + // Load old terminal state to restore. + // + { + if ( 0 != tcgetattr(uty_u->fid_i, &uty_u->bak_u) ) { + c3_assert(!"init-tcgetattr"); + } + if ( -1 == fcntl(uty_u->fid_i, F_GETFL, &uty_u->cug_i) ) { + c3_assert(!"init-fcntl"); + } + uty_u->cug_i &= ~O_NONBLOCK; // could fix? + uty_u->nob_i = uty_u->cug_i | O_NONBLOCK; // O_NDELAY on older unix + } + + // Construct raw termios configuration. + // + { + uty_u->raw_u = uty_u->bak_u; + + uty_u->raw_u.c_lflag &= ~(ECHO | ECHONL | ICANON | IEXTEN); + uty_u->raw_u.c_iflag &= ~(ICRNL | INPCK | ISTRIP); + uty_u->raw_u.c_cflag &= ~(CSIZE | PARENB); + uty_u->raw_u.c_cflag |= CS8; + uty_u->raw_u.c_oflag &= ~(OPOST); + uty_u->raw_u.c_cc[VMIN] = 0; + uty_u->raw_u.c_cc[VTIME] = 0; + } + + // Initialize mirror and accumulator state. + // + { + uty_u->tat_u.mir.lin_w = 0; + uty_u->tat_u.mir.len_w = 0; + uty_u->tat_u.mir.cus_w = 0; + + uty_u->tat_u.esc.ape = c3n; + uty_u->tat_u.esc.bra = c3n; + + uty_u->tat_u.fut.len_w = 0; + uty_u->tat_u.fut.wid_w = 0; + } + } + + // This is terminal 1, linked in host. + // + { + uty_u->tid_l = 1; + uty_u->nex_u = 0; + u3_Host.uty_u = uty_u; + } + + if ( c3n == u3_Host.ops_u.dem ) { + // Start raw input. + // + { + if ( 0 != tcsetattr(uty_u->fid_i, TCSADRAIN, &uty_u->raw_u) ) { + c3_assert(!"init-tcsetattr"); + } + if ( -1 == fcntl(uty_u->fid_i, F_SETFL, uty_u->nob_i) ) { + c3_assert(!"init-fcntl"); + } + } + + // Start spinner thread. + // + { + uty_u->tat_u.sun.sit_u = (uv_thread_t*)malloc(sizeof(uv_thread_t)); + if ( uty_u->tat_u.sun.sit_u ) { + uv_mutex_init(&uty_u->tat_u.mex_u); + uv_mutex_lock(&uty_u->tat_u.mex_u); + + c3_w ret_w = uv_thread_create(uty_u->tat_u.sun.sit_u, + _term_spinner_cb, + uty_u); + if ( 0 != ret_w ) { + u3l_log("term: spinner start: %s\n", uv_strerror(ret_w)); + free(uty_u->tat_u.sun.sit_u); + uty_u->tat_u.sun.sit_u = NULL; + uv_mutex_unlock(&uty_u->tat_u.mex_u); + uv_mutex_destroy(&uty_u->tat_u.mex_u); + } + } + } + } +} + +void +u3_term_io_talk(void) +{ +} + +/* u3_term_io_exit(): clean up terminal. +*/ +void +u3_term_io_exit(void) +{ + if ( c3y == u3_Host.ops_u.dem ) { + uv_close((uv_handle_t*)&u3_Host.uty_u->pop_u, NULL); + } + else { + u3_utty* uty_u; + + for ( uty_u = u3_Host.uty_u; uty_u; uty_u = uty_u->nex_u ) { + if ( uty_u->fid_i == -1 ) { continue; } + if ( 0 != tcsetattr(uty_u->fid_i, TCSADRAIN, &uty_u->bak_u) ) { + c3_assert(!"exit-tcsetattr"); + } + if ( -1 == fcntl(uty_u->fid_i, F_SETFL, uty_u->cug_i) ) { + c3_assert(!"exit-fcntl"); + } + _write(uty_u->fid_i, "\r\n", 2); + +#if 0 + if ( uty_u->tat_u.sun.sit_u ) { + uv_thread_t* sit_u = uty_u->tat_u.sun.sit_u; + uty_u->tat_u.sun.sit_u = NULL; + + uv_mutex_unlock(&uty_u->tat_u.mex_u); + + // XX can block exit waiting for wakeup (max _SPIN_COOL_US) + c3_w ret_w; + if ( 0 != (ret_w = uv_thread_join(sit_u)) ) { + u3l_log("term: spinner exit: %s\n", uv_strerror(ret_w)); + } + else { + uv_mutex_destroy(&uty_u->tat_u.mex_u); + } + + free(sit_u); + } +#endif + } + } +} + +/* _term_it_buf(): create a data buffer. +*/ +static u3_ubuf* +_term_it_buf(c3_w len_w, const c3_y* hun_y) +{ + u3_ubuf* buf_u = c3_malloc(len_w + sizeof(*buf_u)); + + buf_u->len_w = len_w; + memcpy(buf_u->hun_y, hun_y, len_w); + + buf_u->nex_u = 0; + return buf_u; +} + +/* An unusual lameness in libuv. +*/ + typedef struct { + uv_write_t wri_u; + c3_y* buf_y; + } _u3_write_t; + +/* _term_write_cb(): general write callback. +*/ +static void +_term_write_cb(uv_write_t* wri_u, c3_i sas_i) +{ + _u3_write_t* ruq_u = (void *)wri_u; + + if ( 0 != sas_i ) { + // u3l_log("term: write: ERROR\n"); + } + free(ruq_u->buf_y); + free(ruq_u); +} + +/* _term_it_write_buf(): write buffer uv style. +*/ +static void +_term_it_write_buf(u3_utty* uty_u, uv_buf_t buf_u) +{ + _u3_write_t* ruq_u = (_u3_write_t*) c3_malloc(sizeof(_u3_write_t)); + + ruq_u->buf_y = (c3_y*)buf_u.base; + + c3_w ret_w; + if ( 0 != (ret_w = uv_write(&ruq_u->wri_u, + (uv_stream_t*)&(uty_u->pop_u), + &buf_u, 1, + _term_write_cb)) ) + { + u3l_log("terminal: %s\n", uv_strerror(ret_w)); + } +} + +/* _term_it_write_old(): write buffer, transferring pointer. +*/ +static void +_term_it_write_old(u3_utty* uty_u, + u3_ubuf* old_u) +{ + uv_buf_t buf_u; + + // XX extra copy here due to old code. Use hbod as base directly. + // + { + c3_y* buf_y = c3_malloc(old_u->len_w); + + memcpy(buf_y, old_u->hun_y, old_u->len_w); + buf_u = uv_buf_init((c3_c*)buf_y, old_u->len_w); + + free(old_u); + } + _term_it_write_buf(uty_u, buf_u); +} + +/* _term_it_write_bytes(): write bytes, retaining pointer. +*/ +static void +_term_it_write_bytes(u3_utty* uty_u, + c3_w len_w, + const c3_y* hun_y) +{ + _term_it_write_old(uty_u, _term_it_buf(len_w, hun_y)); +} + +/* _term_it_write_txt(): write null-terminated string, retaining pointer. +*/ +static void +_term_it_write_txt(u3_utty* uty_u, + const c3_y* hun_y) +{ + _term_it_write_bytes(uty_u, strlen((const c3_c*)hun_y), hun_y); +} + +/* _term_it_write_str(): write null-terminated string, retaining pointer. +*/ +static void +_term_it_write_str(u3_utty* uty_u, + const c3_c* str_c) +{ + _term_it_write_txt(uty_u, (const c3_y*) str_c); +} + +/* _term_it_show_wide(): show wide text, retaining. +*/ +static void +_term_it_show_wide(u3_utty* uty_u, c3_w len_w, c3_w* txt_w) +{ + u3_noun wad = u3i_words(len_w, txt_w); + u3_noun txt = u3do("tuft", wad); + c3_c* txt_c = u3r_string(txt); + + _term_it_write_str(uty_u, txt_c); + free(txt_c); + u3z(txt); + + uty_u->tat_u.mir.cus_w += len_w; +} + +/* _term_it_show_clear(): clear to the beginning of the current line. +*/ +static void +_term_it_show_clear(u3_utty* uty_u) +{ + if ( uty_u->tat_u.siz.col_l ) { + _term_it_write_str(uty_u, "\r"); + _term_it_write_txt(uty_u, uty_u->ufo_u.out.el_y); + + uty_u->tat_u.mir.len_w = 0; + uty_u->tat_u.mir.cus_w = 0; + } +} + +/* _term_it_show_blank(): blank the screen. +*/ +static void +_term_it_show_blank(u3_utty* uty_u) +{ + _term_it_write_txt(uty_u, uty_u->ufo_u.out.clear_y); +} + +/* _term_it_show_cursor(): set current line, transferring pointer. +*/ +static void +_term_it_show_cursor(u3_utty* uty_u, c3_w cur_w) +{ + if ( cur_w < uty_u->tat_u.mir.cus_w ) { + c3_w dif_w = (uty_u->tat_u.mir.cus_w - cur_w); + + while ( dif_w-- ) { + _term_it_write_txt(uty_u, uty_u->ufo_u.out.cub1_y); + } + } + else if ( cur_w > uty_u->tat_u.mir.cus_w ) { + c3_w dif_w = (cur_w - uty_u->tat_u.mir.cus_w); + + while ( dif_w-- ) { + _term_it_write_txt(uty_u, uty_u->ufo_u.out.cuf1_y); + } + } + uty_u->tat_u.mir.cus_w = cur_w; +} + +/* _term_it_show_line(): set current line +*/ +static void +_term_it_show_line(u3_utty* uty_u, c3_w* lin_w, c3_w len_w) +{ + _term_it_show_wide(uty_u, len_w, lin_w); + + if ( lin_w != uty_u->tat_u.mir.lin_w ) { + if ( uty_u->tat_u.mir.lin_w ) { + free(uty_u->tat_u.mir.lin_w); + } + uty_u->tat_u.mir.lin_w = lin_w; + } + uty_u->tat_u.mir.len_w = len_w; +} + +/* _term_it_refresh_line(): refresh current line. +*/ +static void +_term_it_refresh_line(u3_utty* uty_u) +{ + c3_w len_w = uty_u->tat_u.mir.len_w; + c3_w cus_w = uty_u->tat_u.mir.cus_w; + + _term_it_show_clear(uty_u); + _term_it_show_line(uty_u, uty_u->tat_u.mir.lin_w, len_w); + _term_it_show_cursor(uty_u, cus_w); +} + +/* _term_it_show_more(): new current line. +*/ +static void +_term_it_show_more(u3_utty* uty_u) +{ + if ( c3y == u3_Host.ops_u.dem ) { + _term_it_write_str(uty_u, "\n"); + } else { + _term_it_write_str(uty_u, "\r\n"); + } + uty_u->tat_u.mir.cus_w = 0; +} + +/* _term_it_path(): path for console file. +*/ +static c3_c* +_term_it_path(c3_o fyl, u3_noun pax) +{ + c3_w len_w; + c3_c *pas_c; + + // measure + // + len_w = strlen(u3_Host.dir_c); + { + u3_noun wiz = pax; + + while ( u3_nul != wiz ) { + len_w += (1 + u3r_met(3, u3h(wiz))); + wiz = u3t(wiz); + } + } + + // cut + // + pas_c = c3_malloc(len_w + 1); + strncpy(pas_c, u3_Host.dir_c, len_w); + pas_c[len_w] = '\0'; + { + u3_noun wiz = pax; + c3_c* waq_c = (pas_c + strlen(pas_c)); + + while ( u3_nul != wiz ) { + c3_w tis_w = u3r_met(3, u3h(wiz)); + + if ( (c3y == fyl) && (u3_nul == u3t(wiz)) ) { + *waq_c++ = '.'; + } else *waq_c++ = '/'; + + u3r_bytes(0, tis_w, (c3_y*)waq_c, u3h(wiz)); + waq_c += tis_w; + + wiz = u3t(wiz); + } + *waq_c = 0; + } + u3z(pax); + return pas_c; +} + +/* _term_it_save(): save file by path. +*/ +static void +_term_it_save(u3_noun pax, u3_noun pad) +{ + c3_c* pax_c; + c3_c* bas_c = 0; + c3_w xap_w = u3kb_lent(u3k(pax)); + u3_noun xap = u3_nul; + u3_noun urb = c3_s4('.','u','r','b'); + u3_noun put = c3_s3('p','u','t'); + + // directory base and relative path + if ( 2 < xap_w ) { + u3_noun bas = u3nt(urb, put, u3_nul); + bas_c = _term_it_path(c3n, bas); + xap = u3qb_scag(xap_w - 2, pax); + } + + pax = u3nt(urb, put, pax); + pax_c = _term_it_path(c3y, pax); + + u3_walk_save(pax_c, 0, pad, bas_c, xap); + + free(pax_c); + free(bas_c); +} + +/* _term_io_belt(): send belt. +*/ +static void +_term_io_belt(u3_utty* uty_u, u3_noun blb) +{ + u3_noun tid = u3dc("scot", c3__ud, uty_u->tid_l); + u3_noun pax = u3nq(u3_blip, c3__term, tid, u3_nul); + + u3_pier_plan(pax, u3nc(c3__belt, blb)); +} + +/* _term_io_suck_char(): process a single character. +*/ +static void +_term_io_suck_char(u3_utty* uty_u, c3_y cay_y) +{ + u3_utat* tat_u = &uty_u->tat_u; + + if ( c3y == tat_u->esc.ape ) { + if ( c3y == tat_u->esc.bra ) { + switch ( cay_y ) { + default: { + _term_it_write_txt(uty_u, uty_u->ufo_u.out.bel_y); + break; + } + case 'A': _term_io_belt(uty_u, u3nc(c3__aro, 'u')); break; + case 'B': _term_io_belt(uty_u, u3nc(c3__aro, 'd')); break; + case 'C': _term_io_belt(uty_u, u3nc(c3__aro, 'r')); break; + case 'D': _term_io_belt(uty_u, u3nc(c3__aro, 'l')); break; + } + tat_u->esc.ape = tat_u->esc.bra = c3n; + } + else { + if ( (cay_y >= 'a') && (cay_y <= 'z') ) { + tat_u->esc.ape = c3n; + _term_io_belt(uty_u, u3nc(c3__met, cay_y)); + } + else if ( '.' == cay_y ) { + tat_u->esc.ape = c3n; + _term_io_belt(uty_u, u3nc(c3__met, c3__dot)); + } + else if ( 8 == cay_y || 127 == cay_y ) { + tat_u->esc.ape = c3n; + _term_io_belt(uty_u, u3nc(c3__met, c3__bac)); + } + else if ( ('[' == cay_y) || ('O' == cay_y) ) { + tat_u->esc.bra = c3y; + } + else { + tat_u->esc.ape = c3n; + + _term_it_write_txt(uty_u, uty_u->ufo_u.out.bel_y); + } + } + } + else if ( 0 != tat_u->fut.wid_w ) { + tat_u->fut.syb_y[tat_u->fut.len_w++] = cay_y; + + if ( tat_u->fut.len_w == tat_u->fut.wid_w ) { + u3_noun huv = u3i_bytes(tat_u->fut.wid_w, tat_u->fut.syb_y); + u3_noun wug; + + // u3l_log("muck-utf8 len %d\n", tat_u->fut.len_w); + // u3l_log("muck-utf8 %x\n", huv); + wug = u3do("taft", huv); + // u3l_log("muck-utf32 %x\n", tat_u->fut.len_w); + + tat_u->fut.len_w = tat_u->fut.wid_w = 0; + _term_io_belt(uty_u, u3nt(c3__txt, wug, u3_nul)); + } + } + else { + if ( (cay_y >= 32) && (cay_y < 127) ) { + _term_io_belt(uty_u, u3nt(c3__txt, cay_y, u3_nul)); + } + else if ( 0 == cay_y ) { + _term_it_write_txt(uty_u, uty_u->ufo_u.out.bel_y); + } + else if ( 8 == cay_y || 127 == cay_y ) { + _term_io_belt(uty_u, u3nc(c3__bac, u3_nul)); + } + else if ( 13 == cay_y ) { + _term_io_belt(uty_u, u3nc(c3__ret, u3_nul)); + } +#if 0 + else if ( 6 == cay_y ) { + _term_io_flow(uty_u); // XX hack + } +#endif + else if ( cay_y <= 26 ) { + _term_io_belt(uty_u, u3nc(c3__ctl, ('a' + (cay_y - 1)))); + } + else if ( 27 == cay_y ) { + tat_u->esc.ape = c3y; + } + else if ( cay_y >= 128 ) { + tat_u->fut.len_w = 1; + tat_u->fut.syb_y[0] = cay_y; + + if ( cay_y < 224 ) { + tat_u->fut.wid_w = 2; + } else if ( cay_y < 240 ) { + tat_u->fut.wid_w = 3; + } else tat_u->fut.wid_w = 4; + } + } +} + +/* _term_suck(): process a chunk of input +*/ + +/* + * `nread` (siz_w) is > 0 if there is data available, 0 if libuv is done reading for + * now, or < 0 on error. + * + * The callee is responsible for closing the stream when an error happens + * by calling uv_close(). Trying to read from the stream again is undefined. + * + * The callee is responsible for freeing the buffer, libuv does not reuse it. + * The buffer may be a null buffer (where buf->base=NULL and buf->len=0) on + * error. + */ + +static inline void +_term_suck(u3_utty* uty_u, const c3_y* buf, ssize_t siz_i) +{ + { + if ( siz_i == UV_EOF ) { + // We hear EOF (on the third read callback) if + // 2x the _term_alloc() buffer size is pasted. + // The process hangs if we do nothing (and ctrl-z + // then corrupts the event log), so we force shutdown. + // + u3l_log("term: hangup (EOF)\r\n"); + u3_pier_exit(u3_pier_stub()); + } + else if ( siz_i < 0 ) { + u3l_log("term %d: read: %s\n", uty_u->tid_l, uv_strerror(siz_i)); + } + else { + c3_i i; + + for ( i=0; i < siz_i; i++ ) { + _term_io_suck_char(uty_u, buf[i]); + } + } + } +} + +/* _term_read_cb(): server read callback. +*/ +static void +_term_read_cb(uv_stream_t* tcp_u, + ssize_t siz_i, + const uv_buf_t * buf_u) +{ + u3_utty* uty_u = (u3_utty*)(void*)tcp_u; + _term_suck(uty_u, (const c3_y*)buf_u->base, siz_i); + free(buf_u->base); +} + +/* _term_try_write_str(): write null-terminated string (off-thread, retain). +*/ +static void +_term_try_write_str(u3_utty* uty_u, + const c3_c* hun_y) +{ + // c3_i fid_i = uv_fileno(&uty_u->pop_u); + c3_i fid_i = uty_u->pop_u.io_watcher.fd; // XX old libuv + _write(fid_i, hun_y, strlen(hun_y)); +} + +/* _term_try_move_left(): move the cursor left (off-thread). +*/ +static void +_term_try_move_left(u3_utty* uty_u) +{ + _term_try_write_str(uty_u, (const c3_c*)uty_u->ufo_u.out.cub1_y); +} + +/* _term_show_spinner(): render spinner (off-thread). +*/ +static void +_term_show_spinner(u3_utty* uty_u, c3_d lag_d) +{ + if ( 0 == uty_u->tat_u.sun.eve_d ) { + return; + } + + c3_w cus_w = uty_u->tat_u.mir.cus_w; + + if ( cus_w >= uty_u->tat_u.siz.col_l ) { // shenanigans! + return; + } + + c3_w bac_w = uty_u->tat_u.siz.col_l - 1 - cus_w; // backoff from end of line + + const c3_c daz_c[] = "|/-\\"; + const c3_c dal_c[] = "\xc2\xab"; + const c3_c dar_c[] = "\xc2\xbb"; + + c3_c buf_c[1 + 2 + 4 + 2 + 1]; + // | + « + why + » + \0 + + c3_c* cur_c = buf_c; + + *cur_c++ = daz_c[(lag_d / _SPIN_RATE_US) % strlen(daz_c)]; + c3_w sol_w = 1; // spinner length (utf-32) + + c3_c* why_c = uty_u->tat_u.sun.why_c; + if ( why_c && strlen(why_c) <= 4 ) { + strcpy(cur_c, dal_c); + cur_c += strlen(dal_c); + sol_w += 1; // length of dal_c (utf-32) + + c3_w wel_w = strlen(why_c); + strcpy(cur_c, why_c); + cur_c += wel_w; + sol_w += wel_w; + + strcpy(cur_c, dar_c); + cur_c += strlen(dar_c); + sol_w += 1; // length of dar_c (utf-32) + } + *cur_c = '\0'; + + // One-time cursor backoff. + if ( c3n == uty_u->tat_u.sun.diz_o ) { + c3_w i_w; + for ( i_w = bac_w; i_w < sol_w; i_w++ ) { + _term_try_move_left(uty_u); + } + } + + _term_try_write_str(uty_u, buf_c); + uty_u->tat_u.sun.diz_o = c3y; + + // Cursor stays on spinner. + while ( sol_w-- ) { + _term_try_move_left(uty_u); + } +} + +/* _term_start_spinner(): prepare spinner state. RETAIN. +*/ +static void +_term_start_spinner(u3_utty* uty_u, u3_noun ovo) +{ + uty_u->tat_u.sun.diz_o = c3n; + + c3_d now_d = _term_msc_out_host(); + + // If we receive an event shortly after a previous spin, use a shorter delay + // to avoid giving the impression of a half-idle system. + // + c3_d lag_d; + if ( now_d - uty_u->tat_u.sun.end_d < _SPIN_IDLE_US ) { + lag_d = _SPIN_WARM_US; + } + else { + lag_d = _SPIN_COOL_US; + } + + // second item of the event wire + // + u3_noun why = u3h(u3t(u3h(u3t(ovo)))); + if ( c3__term == why ) { + u3_noun eve = u3t(u3t(ovo)); + if ( c3__belt == u3h(eve) && c3__ret == u3h(u3t(eve)) ) { + lag_d = 0; // No delay for %ret. + } + } + else { + uty_u->tat_u.sun.why_c = (c3_c*)u3r_string(why); + } + + uty_u->tat_u.sun.eve_d = now_d + lag_d; + + uv_mutex_unlock(&uty_u->tat_u.mex_u); +} + +/* u3_term_stop_spinner(): reset spinner state and restore input line. +*/ +static void +_term_stop_spinner(u3_utty* uty_u) +{ + uv_mutex_lock(&uty_u->tat_u.mex_u); + + if ( c3y == uty_u->tat_u.sun.diz_o ) { + _term_it_refresh_line(uty_u); + uty_u->tat_u.sun.end_d = _term_msc_out_host(); + } + else { + uty_u->tat_u.sun.end_d = 0; + } + + uty_u->tat_u.sun.diz_o = c3n; + uty_u->tat_u.sun.eve_d = 0; + free(uty_u->tat_u.sun.why_c); + uty_u->tat_u.sun.why_c = NULL; +} + +/* u3_term_start_spinner(): prepare spinner state. RETAIN. +*/ +void +u3_term_start_spinner(u3_noun ovo) +{ + if ( c3n == u3_Host.ops_u.dem ) { + _term_start_spinner(_term_main(), ovo); + } +} + +/* u3_term_stop_spinner(): reset spinner state and restore input line. +*/ +void +u3_term_stop_spinner(void) +{ + if ( c3n == u3_Host.ops_u.dem ) { + _term_stop_spinner(_term_main()); + } +} + +/* _term_spinner_cb(): manage spinner (off-thread). +*/ +static void +_term_spinner_cb(void* ptr_v) +{ + // This thread shouldn't receive signals. + // + { + sigset_t set; + sigfillset(&set); + pthread_sigmask(SIG_BLOCK, &set, NULL); + } + + u3_utty* uty_u = (u3_utty*)ptr_v; + + for ( uv_mutex_lock(&uty_u->tat_u.mex_u); + uty_u->tat_u.sun.sit_u; + uv_mutex_lock(&uty_u->tat_u.mex_u) ) + { + c3_d eve_d = uty_u->tat_u.sun.eve_d; + + if ( 0 == eve_d ) { + c3_o diz_o = uty_u->tat_u.sun.diz_o; + uv_mutex_unlock(&uty_u->tat_u.mex_u); + usleep(c3y == diz_o ? _SPIN_WARM_US : _SPIN_COOL_US); + } + else { + c3_d now_d = _term_msc_out_host(); + + if (now_d < eve_d) { + uv_mutex_unlock(&uty_u->tat_u.mex_u); + usleep(eve_d - now_d); + } + else { + _term_show_spinner(uty_u, now_d - eve_d); + uv_mutex_unlock(&uty_u->tat_u.mex_u); + usleep(_SPIN_RATE_US); + } + } + } + + uv_mutex_unlock(&uty_u->tat_u.mex_u); +} + +/* _term_main(): return main or console terminal. +*/ +static u3_utty* +_term_main() +{ + u3_utty* uty_u; + + for ( uty_u = u3_Host.uty_u; uty_u; uty_u = uty_u->nex_u ) { + if ( (uty_u->fid_i != -1) && (uty_u->fid_i <= 2) ) { + return uty_u; + } + } + return u3_Host.uty_u; +} + +/* _term_ef_get(): terminal by id. +*/ +static u3_utty* +_term_ef_get(c3_l tid_l) +{ + if ( 0 != tid_l ) { + u3_utty* uty_u; + + for ( uty_u = u3_Host.uty_u; uty_u; uty_u = uty_u->nex_u ) { + if ( tid_l == uty_u->tid_l ) { + return uty_u; + } + } + } + return _term_main(); +} + +/* u3_term_get_blew(): return window size [columns rows]. +*/ +u3_noun +u3_term_get_blew(c3_l tid_l) +{ + u3_utty* uty_u = _term_ef_get(tid_l); + c3_l col_l, row_l; + + struct winsize siz_u; + if ( uty_u && (0 == ioctl(uty_u->fid_i, TIOCGWINSZ, &siz_u)) ) { + col_l = siz_u.ws_col; + row_l = siz_u.ws_row; + } else { + col_l = 80; + row_l = 24; + } + + if ( uty_u ) { + uty_u->tat_u.siz.col_l = col_l; + uty_u->tat_u.siz.row_l = row_l; + } + + return u3nc(col_l, row_l); +} + +/* u3_term_ef_winc(): window change. Just console right now. +*/ +void +u3_term_ef_winc(void) +{ + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + + u3_pier_plan(pax, u3nc(c3__blew, u3_term_get_blew(1))); +} + +/* u3_term_ef_ctlc(): send ^C on console. +*/ +void +u3_term_ef_ctlc(void) +{ + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + + u3_pier_plan(pax, u3nt(c3__belt, c3__ctl, 'c')); + + _term_it_refresh_line(_term_main()); +} + +/* u3_term_ef_verb(): initial effects for verbose events +*/ +void +u3_term_ef_verb(void) +{ + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + + u3_pier_plan(pax, u3nc(c3__verb, u3_nul)); +} + +/* u3_term_ef_bake(): initial effects for new terminal. +*/ +void +u3_term_ef_bake(void) +{ + u3_noun pax = u3nq(u3_blip, c3__term, '1', u3_nul); + + // u3_pier_plan(u3k(pax), u3nq(c3__flow, c3__seat, c3__dojo, u3_nul)); + u3_pier_plan(u3k(pax), u3nc(c3__blew, u3_term_get_blew(1))); + u3_pier_plan(u3k(pax), u3nc(c3__hail, u3_nul)); + + u3z(pax); +} + +/* _term_ef_blit(): send blit to terminal. +*/ +static void +_term_ef_blit(u3_utty* uty_u, + u3_noun blt) +{ + switch ( u3h(blt) ) { + default: break; + case c3__bee: { + if ( c3n == u3_Host.ops_u.dem ) { + if ( u3_nul == u3t(blt) ) { + _term_stop_spinner(uty_u); + } + else { + _term_start_spinner(uty_u, u3t(blt)); + } + } + } break; + + case c3__bel: { + if ( c3n == u3_Host.ops_u.dem ) { + _term_it_write_txt(uty_u, uty_u->ufo_u.out.bel_y); + } + } break; + + case c3__clr: { + if ( c3n == u3_Host.ops_u.dem ) { + _term_it_show_blank(uty_u); + _term_it_refresh_line(uty_u); + } + } break; + + case c3__hop: { + if ( c3n == u3_Host.ops_u.dem ) { + _term_it_show_cursor(uty_u, u3t(blt)); + } + } break; + + case c3__lin: { + u3_noun lin = u3t(blt); + c3_w len_w = u3kb_lent(u3k(lin)); + c3_w* lin_w = c3_malloc(4 * len_w); + + { + c3_w i_w; + + for ( i_w = 0; u3_nul != lin; i_w++, lin = u3t(lin) ) { + lin_w[i_w] = u3r_word(0, u3h(lin)); + } + } + + if ( c3n == u3_Host.ops_u.dem ) { + _term_it_show_clear(uty_u); + _term_it_show_line(uty_u, lin_w, len_w); + } else { + _term_it_show_line(uty_u, lin_w, len_w); + } + } break; + + case c3__mor: { + _term_it_show_more(uty_u); + } break; + + case c3__sav: { + _term_it_save(u3k(u3h(u3t(blt))), u3k(u3t(u3t(blt)))); + } break; + + case c3__sag: { + u3_noun pib = u3k(u3t(u3t(blt))); + u3_noun jam; + + jam = u3ke_jam(pib); + + _term_it_save(u3k(u3h(u3t(blt))), jam); + } break; + + case c3__url: { + if ( c3n == u3ud(u3t(blt)) ) { + break; + } else { + c3_c* txt_c = u3r_string(u3t(blt)); + + _term_it_show_clear(uty_u); + _term_it_write_str(uty_u, txt_c); + free(txt_c); + + _term_it_show_more(uty_u); + _term_it_refresh_line(uty_u); + } + } + } + u3z(blt); + + return; +} + +/* u3_term_ef_blit(): send %blit list to specific terminal. +*/ +void +u3_term_ef_blit(c3_l tid_l, + u3_noun bls) +{ + u3_utty* uty_u = _term_ef_get(tid_l); + + if ( 0 == uty_u ) { + // u3l_log("no terminal %d\n", tid_l); + // u3l_log("uty_u %p\n", u3_Host.uty_u); + + u3z(bls); return; + } + + { + u3_noun bis = bls; + + while ( c3y == u3du(bis) ) { + _term_ef_blit(uty_u, u3k(u3h(bis))); + bis = u3t(bis); + } + u3z(bls); + } +} + +/* u3_term_io_hija(): hijack console for fprintf, returning FILE*. +*/ +FILE* +u3_term_io_hija(void) +{ + u3_utty* uty_u = _term_main(); + + if ( uty_u ) { + if ( uty_u->fid_i > 2 ) { + // We *should* in fact, produce some kind of fake FILE* for + // non-console terminals. If we use this interface enough... + // + c3_assert(0); + } + else { + if ( c3n == u3_Host.ops_u.dem ) { + if ( 0 != tcsetattr(1, TCSADRAIN, &uty_u->bak_u) ) { + perror("hija-tcsetattr-1"); + c3_assert(!"hija-tcsetattr"); + } + if ( -1 == fcntl(1, F_SETFL, uty_u->cug_i) ) { + perror("hija-fcntl-1"); + c3_assert(!"hija-fcntl"); + } + if ( 0 != tcsetattr(0, TCSADRAIN, &uty_u->bak_u) ) { + perror("hija-tcsetattr-0"); + c3_assert(!"hija-tcsetattr"); + } + if ( -1 == fcntl(0, F_SETFL, uty_u->cug_i) ) { + perror("hija-fcntl-0"); + c3_assert(!"hija-fcntl"); + } + _write(uty_u->fid_i, "\r", 1); + _write(uty_u->fid_i, uty_u->ufo_u.out.el_y, + strlen((c3_c*) uty_u->ufo_u.out.el_y)); + } + return stdout; + } + } + else return stdout; +} + +/* u3_term_io_loja(): release console from fprintf. +*/ +void +u3_term_io_loja(int x) +{ + u3_utty* uty_u = _term_main(); + + if ( uty_u ) { + if ( uty_u->fid_i > 2 ) { + // We *should* in fact, produce some kind of fake FILE* for + // non-console terminals. If we use this interface enough... + // + c3_assert(0); + } + else { + if ( c3y == u3_Host.ops_u.dem ) { + fflush(stdout); + } + else { + if ( 0 != tcsetattr(1, TCSADRAIN, &uty_u->raw_u) ) { + perror("loja-tcsetattr-1"); + c3_assert(!"loja-tcsetattr"); + } + if ( -1 == fcntl(1, F_SETFL, uty_u->nob_i) ) { + perror("hija-fcntl-1"); + c3_assert(!"loja-fcntl"); + } + if ( 0 != tcsetattr(0, TCSADRAIN, &uty_u->raw_u) ) { + perror("loja-tcsetattr-0"); + c3_assert(!"loja-tcsetattr"); + } + if ( -1 == fcntl(0, F_SETFL, uty_u->nob_i) ) { + perror("hija-fcntl-0"); + c3_assert(!"loja-fcntl"); + } + _term_it_refresh_line(uty_u); + } + } + } +} + +/* u3_term_it_log(): writes a log message +*/ +void +u3_term_io_log(c3_c* line) +{ + FILE* stream = u3_term_io_hija(); + u3_term_io_loja(fprintf(stream, "%s", line)); +} + +/* u3_term_tape_to(): dump a tape to a file. +*/ +void +u3_term_tape_to(FILE *fil_f, u3_noun tep) +{ + u3_noun tap = tep; + + while ( u3_nul != tap ) { + c3_c car_c; + + if ( u3h(tap) >= 127 ) { + car_c = '?'; + } else car_c = u3h(tap); + + putc(car_c, fil_f); + tap = u3t(tap); + } + u3z(tep); +} + +/* u3_term_tape(): dump a tape to stdout. +*/ +void +u3_term_tape(u3_noun tep) +{ + FILE* fil_f = u3_term_io_hija(); + + u3_term_tape_to(fil_f, tep); + + u3_term_io_loja(0); +} + +/* u3_term_wall(): dump a wall to stdout. +*/ +void +u3_term_wall(u3_noun wol) +{ + FILE* fil_f = u3_term_io_hija(); + u3_noun wal = wol; + + while ( u3_nul != wal ) { + u3_term_tape_to(fil_f, u3k(u3h(wal))); + + putc(13, fil_f); + putc(10, fil_f); + + wal = u3t(wal); + } + u3_term_io_loja(0); + + u3z(wol); +} diff --git a/pkg/hs/vere/notes/c/time.c b/pkg/hs/vere/notes/c/time.c new file mode 100644 index 000000000..2a36cf822 --- /dev/null +++ b/pkg/hs/vere/notes/c/time.c @@ -0,0 +1,179 @@ +/* vere/time.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + +/* u3_time_sec_in(): urbit seconds from unix time. +** +** Adjust for future leap secs! +*/ +c3_d +u3_time_sec_in(c3_w unx_w) +{ + return 0x8000000cce9e0d80ULL + (c3_d)unx_w; +} + +/* u3_time_sec_out(): unix time from urbit seconds. +** +** Adjust for future leap secs! +*/ +c3_w +u3_time_sec_out(c3_d urs_d) +{ + c3_d adj_d = (urs_d - 0x8000000cce9e0d80ULL); + + if ( adj_d > 0xffffffffULL ) { + fprintf(stderr, "Agh! It's 2106! And no one's fixed this shite!\n"); + exit(1); + } + return (c3_w)adj_d; +} + +/* u3_time_fsc_in(): urbit fracto-seconds from unix microseconds. +*/ +c3_d +u3_time_fsc_in(c3_w usc_w) +{ + c3_d usc_d = usc_w; + + return ((usc_d * 65536ULL) / 1000000ULL) << 48ULL; +} + +/* u3_time_fsc_out: unix microseconds from urbit fracto-seconds. +*/ +c3_w +u3_time_fsc_out(c3_d ufc_d) +{ + return (c3_w) (((ufc_d >> 48ULL) * 1000000ULL) / 65536ULL); +} + +/* u3_time_msc_out: unix microseconds from urbit fracto-seconds. +*/ +c3_w +u3_time_msc_out(c3_d ufc_d) +{ + return (c3_w) (((ufc_d >> 48ULL) * 1000ULL) / 65536ULL); +} + +/* u3_time_in_tv(): urbit time from struct timeval. +*/ +u3_atom +u3_time_in_tv(struct timeval* tim_tv) +{ + c3_w unx_w = tim_tv->tv_sec; + c3_w usc_w = tim_tv->tv_usec; + c3_d cub_d[2]; + + cub_d[0] = u3_time_fsc_in(usc_w); + cub_d[1] = u3_time_sec_in(unx_w); + + return u3i_chubs(2, cub_d); +} + +/* u3_time_out_tv(): struct timeval from urbit time. +*/ +void +u3_time_out_tv(struct timeval* tim_tv, u3_noun now) +{ + c3_d ufc_d = u3r_chub(0, now); + c3_d urs_d = u3r_chub(1, now); + + tim_tv->tv_sec = u3_time_sec_out(urs_d); + tim_tv->tv_usec = u3_time_fsc_out(ufc_d); + + u3z(now); +} + +/* u3_time_in_ts(): urbit time from struct timespec. +*/ +u3_atom +u3_time_in_ts(struct timespec* tim_ts) +{ + struct timeval tim_tv; + + tim_tv.tv_sec = tim_ts->tv_sec; + tim_tv.tv_usec = (tim_ts->tv_nsec / 1000); + + return u3_time_in_tv(&tim_tv); +} + +#if defined(U3_OS_linux) +/* u3_time_t_in_ts(): urbit time from time_t. +*/ +u3_atom +u3_time_t_in_ts(time_t tim) +{ + struct timeval tim_tv; + + tim_tv.tv_sec = tim; + tim_tv.tv_usec = 0; + + return u3_time_in_tv(&tim_tv); +} +#endif // defined(U3_OS_linux) + +/* u3_time_out_ts(): struct timespec from urbit time. +*/ +void +u3_time_out_ts(struct timespec* tim_ts, u3_noun now) +{ + struct timeval tim_tv; + + u3_time_out_tv(&tim_tv, now); + + tim_ts->tv_sec = tim_tv.tv_sec; + tim_ts->tv_nsec = (tim_tv.tv_usec * 1000); +} + +/* u3_time_gap_ms(): (wen - now) in ms. +*/ +c3_d +u3_time_gap_ms(u3_noun now, u3_noun wen) +{ + if ( c3n == u3ka_gth(u3k(wen), u3k(now)) ) { + u3z(wen); u3z(now); + return 0ULL; + } + else { + u3_noun dif = u3ka_sub(wen, now); + c3_d fsc_d = u3r_chub(0, dif); + c3_d sec_d = u3r_chub(1, dif); + + u3z(dif); + return (sec_d * 1000ULL) + u3_time_msc_out(fsc_d); + } +} + +/* u3_time_gap_double(): (wen - now) in libev resolution. +*/ +double +u3_time_gap_double(u3_noun now, u3_noun wen) +{ + mpz_t now_mp, wen_mp, dif_mp; + double sec_g = (((double)(1ULL << 32ULL)) * ((double)(1ULL << 32ULL))); + double gap_g, dif_g; + + u3r_mp(now_mp, now); + u3r_mp(wen_mp, wen); + mpz_init(dif_mp); + mpz_sub(dif_mp, wen_mp, now_mp); + + u3z(now); + u3z(wen); + + dif_g = mpz_get_d(dif_mp) / sec_g; + gap_g = (dif_g > 0.0) ? dif_g : 0.0; + mpz_clear(dif_mp); mpz_clear(wen_mp); mpz_clear(now_mp); + + return gap_g; +} diff --git a/pkg/hs/vere/notes/c/unix.c b/pkg/hs/vere/notes/c/unix.c new file mode 100644 index 000000000..e3a013293 --- /dev/null +++ b/pkg/hs/vere/notes/c/unix.c @@ -0,0 +1,1333 @@ +/* vere/unix.c +** +*/ +#include "all.h" +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "vere/vere.h" + +c3_w u3_readdir_r(DIR *dirp, struct dirent *entry, struct dirent **result) +{ + errno = 0; + struct dirent * tmp_u = readdir(dirp); + + if (NULL == tmp_u){ + *result = NULL; + return (errno); // either success or error code + } else { + memcpy(entry, tmp_u, sizeof(struct dirent)); + *result = entry; + } + + return(0); +} + + +/* _unix_down(): descend path. +*/ +static c3_c* +_unix_down(c3_c* pax_c, c3_c* sub_c) +{ + c3_w pax_w = strlen(pax_c); + c3_w sub_w = strlen(sub_c); + c3_c* don_c = c3_malloc(pax_w + sub_w + 2); + + strncpy(don_c, pax_c, pax_w); + don_c[pax_w] = '/'; + strncpy(don_c + pax_w + 1, sub_c, sub_w); + don_c[pax_w + 1 + sub_w] = '\0'; + + return don_c; +} + +/* _unix_string_to_path(): convert c string to u3_noun path + * + * c string must begin with the pier path plus mountpoint +*/ +static u3_noun +_unix_string_to_path_helper(c3_c* pax_c) { + c3_assert(pax_c[-1] == '/'); + c3_c* end_w = strchr(pax_c, '/'); + if ( !end_w ) { + end_w = strrchr(pax_c, '.'); + if ( !end_w ) { + return u3nc(u3i_string(pax_c), u3_nul); + } + else { + return u3nt(u3i_bytes(end_w - pax_c, (c3_y*) pax_c), + u3i_string(end_w + 1), + u3_nul); + } + } + else { + return u3nc(u3i_bytes(end_w - pax_c, (c3_y*) pax_c), + _unix_string_to_path_helper(end_w + 1)); + } +} +static u3_noun +_unix_string_to_path(u3_pier *pir_u, c3_c* pax_c) { + pax_c += strlen(pir_u->pax_c) + 1; + c3_c* pox_c = strchr(pax_c, '/'); + if ( !pox_c ) { + pox_c = strchr(pax_c, '.'); + if ( !pox_c ) { + return u3_nul; + } + else { + return u3nc(u3i_string(pox_c + 1), u3_nul); + } + } + else { + return _unix_string_to_path_helper(pox_c + 1); + } +} + +/* _unix_rm_r_cb(): callback to delete individual files/directories +*/ +static c3_i +_unix_rm_r_cb(const c3_c* pax_c, + const struct stat* buf_u, + c3_i typeflag, + struct FTW* ftw_u) +{ + switch ( typeflag ) { + default: + u3l_log("bad file type in rm_r: %s\r\n", pax_c); + break; + case FTW_F: + if ( 0 != unlink(pax_c) && ENOENT != errno ) { + u3l_log("error unlinking (in rm_r) %s: %s\n", + pax_c, strerror(errno)); + c3_assert(0); + } + break; + case FTW_D: + u3l_log("shouldn't have gotten pure directory: %s\r\n", pax_c); + break; + case FTW_DNR: + u3l_log("couldn't read directory: %s\r\n", pax_c); + break; + case FTW_NS: + u3l_log("couldn't stat path: %s\r\n", pax_c); + break; + case FTW_DP: + if ( 0 != rmdir(pax_c) && ENOENT != errno ) { + u3l_log("error rmdiring %s: %s\n", pax_c, strerror(errno)); + c3_assert(0); + } + break; + case FTW_SL: + u3l_log("got symbolic link: %s\r\n", pax_c); + break; + case FTW_SLN: + u3l_log("got nonexistent symbolic link: %s\r\n", pax_c); + break; + } + + return 0; +} + +/* _unix_rm_r(): rm -r directory +*/ +static void +_unix_rm_r(c3_c* pax_c) +{ + if ( 0 > nftw(pax_c, _unix_rm_r_cb, 100, FTW_DEPTH | FTW_PHYS ) + && ENOENT != errno) { + u3l_log("rm_r error on %s: %s\r\n", pax_c, strerror(errno)); + } +} + +/* _unix_mkdir(): mkdir, asserting. +*/ +static void +_unix_mkdir(c3_c* pax_c) +{ + if ( 0 != mkdir(pax_c, 0755) && EEXIST != errno) { + u3l_log("error mkdiring %s: %s\n", pax_c, strerror(errno)); + c3_assert(0); + } +} + +/* _unix_write_file_hard(): write to a file, overwriting what's there +*/ +static c3_w +_unix_write_file_hard(c3_c* pax_c, u3_noun mim) +{ + c3_i fid_i = open(pax_c, O_WRONLY | O_CREAT | O_TRUNC, 0666); + c3_w len_w, rit_w, siz_w, mug_w = 0; + c3_y* dat_y; + + u3_noun dat = u3t(u3t(mim)); + + if ( fid_i < 0 ) { + u3l_log("error opening %s for writing: %s\r\n", + pax_c, strerror(errno)); + u3z(mim); + return 0; + } + + siz_w = u3h(u3t(mim)); + len_w = u3r_met(3, dat); + dat_y = c3_calloc(siz_w); + + u3r_bytes(0, len_w, dat_y, dat); + u3z(mim); + + rit_w = write(fid_i, dat_y, siz_w); + + if ( rit_w != siz_w ) { + u3l_log("error writing %s: %s\r\n", + pax_c, strerror(errno)); + mug_w = 0; + } + else { + mug_w = u3r_mug_bytes(dat_y, len_w); + } + + close(fid_i); + free(dat_y); + + return mug_w; +} + +/* _unix_write_file_soft(): write to a file, not overwriting if it's changed +*/ +static void +_unix_write_file_soft(u3_ufil* fil_u, u3_noun mim) +{ + struct stat buf_u; + c3_i fid_i = open(fil_u->pax_c, O_RDONLY, 0644); + c3_ws len_ws, red_ws; + c3_w old_w; + c3_y* old_y; + + if ( fid_i < 0 || fstat(fid_i, &buf_u) < 0 ) { + if ( ENOENT == errno ) { + goto _unix_write_file_soft_go; + } + else { + u3l_log("error opening file (soft) %s: %s\r\n", + fil_u->pax_c, strerror(errno)); + u3z(mim); + return; + } + } + + len_ws = buf_u.st_size; + old_y = c3_malloc(len_ws); + + red_ws = read(fid_i, old_y, len_ws); + + if ( close(fid_i) < 0 ) { + u3l_log("error closing file (soft) %s: %s\r\n", + fil_u->pax_c, strerror(errno)); + } + + if ( len_ws != red_ws ) { + if ( red_ws < 0 ) { + u3l_log("error reading file (soft) %s: %s\r\n", + fil_u->pax_c, strerror(errno)); + } + else { + u3l_log("wrong # of bytes read in file %s: %d %d\r\n", + fil_u->pax_c, len_ws, red_ws); + } + free(old_y); + u3z(mim); + return; + } + + old_w = u3r_mug_bytes(old_y, len_ws); + + if ( old_w != fil_u->gum_w ) { + fil_u->gum_w = u3r_mug(u3t(u3t(mim))); // XXX this might fail with + free(old_y); // trailing zeros + u3z(mim); + return; + } + + free(old_y); + +_unix_write_file_soft_go: + fil_u->gum_w = _unix_write_file_hard(fil_u->pax_c, mim); +} + +static void +_unix_watch_dir(u3_udir* dir_u, u3_udir* par_u, c3_c* pax_c); +static void +_unix_watch_file(u3_pier *pir_u, u3_ufil* fil_u, u3_udir* par_u, c3_c* pax_c); + +/* _unix_get_mount_point(): retrieve or create mount point +*/ +static u3_umon* +_unix_get_mount_point(u3_pier *pir_u, u3_noun mon) +{ + if ( c3n == u3ud(mon) ) { + c3_assert(!"mount point must be an atom"); + u3z(mon); + return NULL; + } + + c3_c* nam_c = u3r_string(mon); + u3_umon* mon_u; + + for ( mon_u = pir_u->unx_u->mon_u; + mon_u && 0 != strcmp(nam_c, mon_u->nam_c); + mon_u = mon_u->nex_u ) + { + } + + if ( !mon_u ) { + mon_u = c3_malloc(sizeof(u3_umon)); + mon_u->nam_c = nam_c; + mon_u->dir_u.dir = c3y; + mon_u->dir_u.dry = c3n; + mon_u->dir_u.pax_c = strdup(pir_u->pax_c); + mon_u->dir_u.par_u = NULL; + mon_u->dir_u.nex_u = NULL; + mon_u->dir_u.kid_u = NULL; + mon_u->nex_u = pir_u->unx_u->mon_u; + pir_u->unx_u->mon_u = mon_u; + + } + else { + free(nam_c); + } + + u3z(mon); + + return mon_u; +} + +/* _unix_scan_mount_point(): scan unix for already-existing mount point +*/ +static void +_unix_scan_mount_point(u3_pier *pir_u, u3_umon* mon_u) +{ + DIR* rid_u = opendir(mon_u->dir_u.pax_c); + if ( !rid_u ) { + u3l_log("error opening pier directory: %s: %s\r\n", + mon_u->dir_u.pax_c, strerror(errno)); + return; + } + + c3_w len_w = strlen(mon_u->nam_c); + + while ( 1 ) { + struct dirent ent_u; + struct dirent* out_u; + c3_w err_w; + + if ( 0 != (err_w = u3_readdir_r(rid_u, &ent_u, &out_u)) ) { + u3l_log("erroring loading pier directory %s: %s\r\n", + mon_u->dir_u.pax_c, strerror(errno)); + + c3_assert(0); + } + else if ( !out_u ) { + break; + } + else if ( '.' == out_u->d_name[0] ) { // unnecessary, but consistency + continue; + } + else if ( 0 != strncmp(mon_u->nam_c, out_u->d_name, len_w) ) { + continue; + } + else { + c3_c* pax_c = _unix_down(mon_u->dir_u.pax_c, out_u->d_name); + + struct stat buf_u; + + if ( 0 != stat(pax_c, &buf_u) ) { + u3l_log("can't stat pier directory %s: %s\r\n", + mon_u->dir_u.pax_c, strerror(errno)); + free(pax_c); + continue; + } + if ( S_ISDIR(buf_u.st_mode) ) { + if ( out_u->d_name[len_w] != '\0' ) { + free(pax_c); + continue; + } + else { + u3_udir* dir_u = c3_malloc(sizeof(u3_udir)); + _unix_watch_dir(dir_u, &mon_u->dir_u, pax_c); + } + } + else { + if ( '.' != out_u->d_name[len_w] + || '\0' == out_u->d_name[len_w + 1] + || '~' == out_u->d_name[strlen(out_u->d_name) - 1] + || ('#' == out_u->d_name[0] && + '#' == out_u->d_name[strlen(out_u->d_name) - 1]) + ) { + free(pax_c); + continue; + } + else { + u3_ufil* fil_u = c3_malloc(sizeof(u3_ufil)); + _unix_watch_file(pir_u, fil_u, &mon_u->dir_u, pax_c); + } + } + + free(pax_c); + } + } +} + +static u3_noun _unix_free_node(u3_pier *pir_u, u3_unod* nod_u); + +/* _unix_free_file(): free file, unlinking it +*/ +static void +_unix_free_file(u3_ufil *fil_u) +{ + if ( 0 != unlink(fil_u->pax_c) && ENOENT != errno ) { + u3l_log("error unlinking %s: %s\n", fil_u->pax_c, strerror(errno)); + c3_assert(0); + } + + free(fil_u->pax_c); + free(fil_u); +} + +/* _unix_free_dir(): free directory, deleting everything within +*/ +static void +_unix_free_dir(u3_udir *dir_u) +{ + _unix_rm_r(dir_u->pax_c); + + if ( dir_u->kid_u ) { + fprintf(stderr, "don't kill me, i've got a family %s\r\n", dir_u->pax_c); + } + else { + // fprintf(stderr, "i'm a lone, lonely loner %s\r\n", dir_u->pax_c); + } + free(dir_u->pax_c); + free(dir_u); // XXX this might be too early, how do we + // know we've freed all the children? + // i suspect we should do this only if + // our kid list is empty +} + +/* _unix_free_node(): free node, deleting everything within + * + * also deletes from parent list if in it +*/ +static u3_noun +_unix_free_node(u3_pier *pir_u, u3_unod* nod_u) +{ + u3_noun can; + if ( nod_u->par_u ) { + u3_unod* don_u = nod_u->par_u->kid_u; + + if ( !don_u ) { + } + else if ( nod_u == don_u ) { + nod_u->par_u->kid_u = nod_u->par_u->kid_u->nex_u; + } + else { + for ( ; don_u->nex_u && nod_u != don_u->nex_u; don_u = don_u->nex_u ) { + } + if ( don_u->nex_u ) { + don_u->nex_u = don_u->nex_u->nex_u; + } + } + } + + if ( c3y == nod_u->dir ) { + can = u3_nul; + u3_unod* nud_u = ((u3_udir*) nod_u)->kid_u; + while ( nud_u ) { + u3_unod* nex_u = nud_u->nex_u; + can = u3kb_weld(_unix_free_node(pir_u, nud_u), can); + nud_u = nex_u; + } + _unix_free_dir((u3_udir *)nod_u); + } + else { + can = u3nc(u3nc(_unix_string_to_path(pir_u, nod_u->pax_c), u3_nul), + u3_nul); + _unix_free_file((u3_ufil *)nod_u); + } + + return can; +} + +/* _unix_free_mount_point(): free mount point + * + * this process needs to happen in a very careful order. in particular, + * we must recurse before we get to the callback, so that libuv does all + * the child directories before it does us. + * + * tread carefully +*/ +static void +_unix_free_mount_point(u3_pier *pir_u, u3_umon* mon_u) +{ + u3_unod* nod_u; + for ( nod_u = mon_u->dir_u.kid_u; nod_u; ) { + u3_unod* nex_u = nod_u->nex_u; + u3z(_unix_free_node(pir_u, nod_u)); + nod_u = nex_u; + } + + free(mon_u->dir_u.pax_c); + free(mon_u->nam_c); + free(mon_u); +} + +/* _unix_delete_mount_point(): remove mount point from list and free +*/ +static void +_unix_delete_mount_point(u3_pier *pir_u, u3_noun mon) +{ + if ( c3n == u3ud(mon) ) { + c3_assert(!"mount point must be an atom"); + u3z(mon); + return; + } + + c3_c* nam_c = u3r_string(mon); + u3_umon* mon_u; + u3_umon* tem_u; + + mon_u = pir_u->unx_u->mon_u; + if ( !mon_u ) { + u3l_log("mount point already gone: %s\r\n", nam_c); + goto _delete_mount_point_out; + } + if ( 0 == strcmp(nam_c, mon_u->nam_c) ) { + pir_u->unx_u->mon_u = mon_u->nex_u; + _unix_free_mount_point(pir_u, mon_u); + goto _delete_mount_point_out; + } + + for ( ; + mon_u->nex_u && 0 != strcmp(nam_c, mon_u->nex_u->nam_c); + mon_u = mon_u->nex_u ) + { + } + + if ( !mon_u->nex_u ) { + u3l_log("mount point already gone: %s\r\n", nam_c); + goto _delete_mount_point_out; + } + + tem_u = mon_u->nex_u; + mon_u->nex_u = mon_u->nex_u->nex_u; + _unix_free_mount_point(pir_u, tem_u); + +_delete_mount_point_out: + free(nam_c); + u3z(mon); +} + +/* _unix_commit_mount_point: commit from mount point +*/ +static void +_unix_commit_mount_point(u3_pier *pir_u, u3_noun mon) +{ + pir_u->unx_u->dyr = c3y; + u3z(mon); + u3_unix_ef_look(pir_u, c3n); + return; +} + +/* _unix_watch_file(): initialize file +*/ +static void +_unix_watch_file(u3_pier *pir_u, u3_ufil* fil_u, u3_udir* par_u, c3_c* pax_c) +{ + // initialize fil_u + + fil_u->dir = c3n; + fil_u->dry = c3n; + fil_u->pax_c = c3_malloc(1 + strlen(pax_c)); + strcpy(fil_u->pax_c, pax_c); + fil_u->par_u = par_u; + fil_u->nex_u = NULL; + fil_u->mug_w = 0; + fil_u->gum_w = 0; + + if ( par_u ) { + fil_u->nex_u = par_u->kid_u; + par_u->kid_u = (u3_unod*) fil_u; + } +} + +/* _unix_watch_dir(): initialize directory +*/ +static void +_unix_watch_dir(u3_udir* dir_u, u3_udir* par_u, c3_c* pax_c) +{ + // initialize dir_u + + dir_u->dir = c3y; + dir_u->dry = c3n; + dir_u->pax_c = c3_malloc(1 + strlen(pax_c)); + strcpy(dir_u->pax_c, pax_c); + dir_u->par_u = par_u; + dir_u->nex_u = NULL; + dir_u->kid_u = NULL; + + if ( par_u ) { + dir_u->nex_u = par_u->kid_u; + par_u->kid_u = (u3_unod*) dir_u; + } +} + +/* _unix_create_dir(): create unix directory and watch it +*/ +static void +_unix_create_dir(u3_udir* dir_u, u3_udir* par_u, u3_noun nam) +{ + c3_c* nam_c = u3r_string(nam); + c3_w nam_w = strlen(nam_c); + c3_w pax_w = strlen(par_u->pax_c); + c3_c* pax_c = c3_malloc(pax_w + 1 + nam_w + 1); + + strncpy(pax_c, par_u->pax_c, pax_w); + pax_c[pax_w] = '/'; + strncpy(pax_c + pax_w + 1, nam_c, nam_w); + pax_c[pax_w + 1 + nam_w] = '\0'; + + free(nam_c); + u3z(nam); + + _unix_mkdir(pax_c); + _unix_watch_dir(dir_u, par_u, pax_c); +} + +static u3_noun _unix_update_node(u3_pier *pir_u, u3_unod* nod_u); + +/* _unix_update_file(): update file, producing list of changes + * + * when scanning through files, if dry, do nothing. otherwise, mark as + * dry, then check if file exists. if not, remove self from node list + * and add path plus sig to %into event. otherwise, read the file and + * get a mug checksum. if same as mug_w, move on. otherwise, overwrite + * mug_w with new mug and add path plus data to %into event. +*/ +static u3_noun +_unix_update_file(u3_pier *pir_u, u3_ufil* fil_u) +{ + c3_assert( c3n == fil_u->dir ); + + if ( c3y == fil_u->dry ) { + return u3_nul; + } + + fil_u->dry = c3n; + + struct stat buf_u; + c3_i fid_i = open(fil_u->pax_c, O_RDONLY, 0644); + c3_ws len_ws, red_ws; + c3_y* dat_y; + + if ( fid_i < 0 || fstat(fid_i, &buf_u) < 0 ) { + if ( ENOENT == errno ) { + return u3nc(u3nc(_unix_string_to_path(pir_u, fil_u->pax_c), u3_nul), u3_nul); + } + else { + u3l_log("error opening file %s: %s\r\n", + fil_u->pax_c, strerror(errno)); + return u3_nul; + } + } + + len_ws = buf_u.st_size; + dat_y = c3_malloc(len_ws); + + red_ws = read(fid_i, dat_y, len_ws); + + if ( close(fid_i) < 0 ) { + u3l_log("error closing file %s: %s\r\n", + fil_u->pax_c, strerror(errno)); + } + + if ( len_ws != red_ws ) { + if ( red_ws < 0 ) { + u3l_log("error reading file %s: %s\r\n", + fil_u->pax_c, strerror(errno)); + } + else { + u3l_log("wrong # of bytes read in file %s: %d %d\r\n", + fil_u->pax_c, len_ws, red_ws); + } + free(dat_y); + return u3_nul; + } + else { + c3_w mug_w = u3r_mug_bytes(dat_y, len_ws); + if ( mug_w == fil_u->mug_w ) { + free(dat_y); + return u3_nul; + } + else if ( mug_w == fil_u->gum_w ) { + fil_u->mug_w = mug_w; + free(dat_y); + return u3_nul; + } + else { + fil_u->mug_w = mug_w; + + u3_noun pax = _unix_string_to_path(pir_u, fil_u->pax_c); + u3_noun mim = u3nt(c3__text, u3i_string("plain"), u3_nul); + u3_noun dat = u3nt(mim, len_ws, u3i_bytes(len_ws, dat_y)); + + free(dat_y); + return u3nc(u3nt(pax, u3_nul, dat), u3_nul); + } + } +} + +/* _unix_update_dir(): update directory, producing list of changes + * + * when changing this, consider whether to also change + * _unix_initial_update_dir() +*/ +static u3_noun +_unix_update_dir(u3_pier *pir_u, u3_udir* dir_u) +{ + u3_noun can = u3_nul; + + c3_assert( c3y == dir_u->dir ); + + if ( c3y == dir_u->dry ) { + return u3_nul; + } + + dir_u->dry = c3n; + + // Check that old nodes are still there + + u3_unod* nod_u = dir_u->kid_u; + + if ( nod_u ) { + while ( nod_u ) { + if ( c3y == nod_u->dry ) { + nod_u = nod_u->nex_u; + } + else { + if ( c3y == nod_u->dir ) { + DIR* red_u = opendir(nod_u->pax_c); + if ( 0 == red_u ) { + u3_unod* nex_u = nod_u->nex_u; + can = u3kb_weld(_unix_free_node(pir_u, nod_u), can); + nod_u = nex_u; + } + else { + closedir(red_u); + nod_u = nod_u->nex_u; + } + } + else { + struct stat buf_u; + c3_i fid_i = open(nod_u->pax_c, O_RDONLY, 0644); + + if ( (fid_i < 0) || (fstat(fid_i, &buf_u) < 0) ) { + if ( ENOENT != errno ) { + u3l_log("_unix_update_dir: error opening file %s: %s\r\n", + nod_u->pax_c, strerror(errno)); + } + + u3_unod* nex_u = nod_u->nex_u; + can = u3kb_weld(_unix_free_node(pir_u, nod_u), can); + nod_u = nex_u; + } + else { + if ( close(fid_i) < 0 ) { + u3l_log("_unix_update_dir: error closing file %s: %s\r\n", + nod_u->pax_c, strerror(errno)); + } + + nod_u = nod_u->nex_u; + } + } + } + } + } + + // Check for new nodes + + DIR* rid_u = opendir(dir_u->pax_c); + if ( !rid_u ) { + u3l_log("error opening directory %s: %s\r\n", + dir_u->pax_c, strerror(errno)); + c3_assert(0); + } + + while ( 1 ) { + struct dirent ent_u; + struct dirent* out_u; + c3_w err_w; + + + if ( (err_w = u3_readdir_r(rid_u, &ent_u, &out_u)) != 0 ) { + u3l_log("error loading directory %s: %s\r\n", + dir_u->pax_c, strerror(err_w)); + c3_assert(0); + } + else if ( !out_u ) { + break; + } + else if ( '.' == out_u->d_name[0] ) { + continue; + } + else { + c3_c* pax_c = _unix_down(dir_u->pax_c, out_u->d_name); + + struct stat buf_u; + + if ( 0 != stat(pax_c, &buf_u) ) { + u3l_log("can't stat %s: %s\r\n", pax_c, strerror(errno)); + free(pax_c); + continue; + } + else { + u3_unod* nod_u; + for ( nod_u = dir_u->kid_u; nod_u; nod_u = nod_u->nex_u ) { + if ( 0 == strcmp(pax_c, nod_u->pax_c) ) { + if ( S_ISDIR(buf_u.st_mode) ) { + if ( c3n == nod_u->dir ) { + u3l_log("not a directory: %s\r\n", nod_u->pax_c); + c3_assert(0); + } + } + else { + if ( c3y == nod_u->dir ) { + u3l_log("not a file: %s\r\n", nod_u->pax_c); + c3_assert(0); + } + } + break; + } + } + + if ( !nod_u ) { + if ( !S_ISDIR(buf_u.st_mode) ) { + if ( !strchr(out_u->d_name,'.') + || '~' == out_u->d_name[strlen(out_u->d_name) - 1] + || ('#' == out_u->d_name[0] && + '#' == out_u->d_name[strlen(out_u->d_name) - 1]) + ) { + free(pax_c); + continue; + } + + u3_ufil* fil_u = c3_malloc(sizeof(u3_ufil)); + _unix_watch_file(pir_u, fil_u, dir_u, pax_c); + } + else { + u3_udir* dis_u = c3_malloc(sizeof(u3_udir)); + _unix_watch_dir(dis_u, dir_u, pax_c); + can = u3kb_weld(_unix_update_dir(pir_u, dis_u), can); // XXX unnecessary? + } + } + } + + free(pax_c); + } + } + + if ( closedir(rid_u) < 0 ) { + u3l_log("error closing directory %s: %s\r\n", + dir_u->pax_c, strerror(errno)); + } + + if ( !dir_u->kid_u ) { + return u3kb_weld(_unix_free_node(pir_u, (u3_unod*) dir_u), can); + } + + // get change list + + for ( nod_u = dir_u->kid_u; nod_u; nod_u = nod_u->nex_u ) { + can = u3kb_weld(_unix_update_node(pir_u, nod_u), can); + } + + return can; +} + +/* _unix_update_node(): update node, producing list of changes +*/ +static u3_noun +_unix_update_node(u3_pier *pir_u, u3_unod* nod_u) +{ + if ( c3y == nod_u->dir ) { + return _unix_update_dir(pir_u, (void*)nod_u); + } + else { + return _unix_update_file(pir_u, (void*)nod_u); + } +} + +/* _unix_update_mount(): update mount point +*/ +static void +_unix_update_mount(u3_pier *pir_u, u3_umon* mon_u, u3_noun all) +{ + if ( c3n == mon_u->dir_u.dry ) { + u3_noun can = u3_nul; + u3_unod* nod_u; + for ( nod_u = mon_u->dir_u.kid_u; nod_u; nod_u = nod_u->nex_u ) { + can = u3kb_weld(_unix_update_node(pir_u, nod_u), can); + } + + u3_pier_work(pir_u, + u3nq(u3_blip, c3__sync, u3k(u3A->sen), u3_nul), + u3nq(c3__into, u3i_string(mon_u->nam_c), all, can)); + } +} + +/* _unix_initial_update_file(): read file, but don't watch +** XX deduplicate with _unix_update_file() +*/ +static u3_noun +_unix_initial_update_file(c3_c* pax_c, c3_c* bas_c) +{ + struct stat buf_u; + c3_i fid_i = open(pax_c, O_RDONLY, 0644); + c3_ws len_ws, red_ws; + c3_y* dat_y; + + if ( fid_i < 0 || fstat(fid_i, &buf_u) < 0 ) { + if ( ENOENT == errno ) { + return u3_nul; + } + else { + u3l_log("error opening initial file %s: %s\r\n", + pax_c, strerror(errno)); + return u3_nul; + } + } + + len_ws = buf_u.st_size; + dat_y = c3_malloc(len_ws); + + red_ws = read(fid_i, dat_y, len_ws); + + if ( close(fid_i) < 0 ) { + u3l_log("error closing initial file %s: %s\r\n", + pax_c, strerror(errno)); + } + + if ( len_ws != red_ws ) { + if ( red_ws < 0 ) { + u3l_log("error reading initial file %s: %s\r\n", + pax_c, strerror(errno)); + } + else { + u3l_log("wrong # of bytes read in initial file %s: %d %d\r\n", + pax_c, len_ws, red_ws); + } + free(dat_y); + return u3_nul; + } + else { + u3_noun pax = _unix_string_to_path_helper(pax_c + + strlen(bas_c) + + 1); /* XX slightly less VERY BAD than before*/ + u3_noun mim = u3nt(c3__text, u3i_string("plain"), u3_nul); + u3_noun dat = u3nt(mim, len_ws, u3i_bytes(len_ws, dat_y)); + + free(dat_y); + return u3nc(u3nt(pax, u3_nul, dat), u3_nul); + } +} + +/* _unix_initial_update_dir(): read directory, but don't watch +** XX deduplicate with _unix_update_dir() +*/ +static u3_noun +_unix_initial_update_dir(c3_c* pax_c, c3_c* bas_c) +{ + u3_noun can = u3_nul; + + DIR* rid_u = opendir(pax_c); + if ( !rid_u ) { + u3l_log("error opening initial directory: %s: %s\r\n", + pax_c, strerror(errno)); + return u3_nul; + } + + while ( 1 ) { + struct dirent ent_u; + struct dirent* out_u; + c3_w err_w; + + if ( 0 != (err_w = u3_readdir_r(rid_u, &ent_u, &out_u)) ) { + u3l_log("error loading initial directory %s: %s\r\n", + pax_c, strerror(errno)); + + c3_assert(0); + } + else if ( !out_u ) { + break; + } + else if ( '.' == out_u->d_name[0] ) { + continue; + } + else { + c3_c* pox_c = _unix_down(pax_c, out_u->d_name); + + struct stat buf_u; + + if ( 0 != stat(pox_c, &buf_u) ) { + u3l_log("initial can't stat %s: %s\r\n", + pox_c, strerror(errno)); + free(pox_c); + continue; + } + else { + if ( S_ISDIR(buf_u.st_mode) ) { + can = u3kb_weld(_unix_initial_update_dir(pox_c, bas_c), can); + } + else { + can = u3kb_weld(_unix_initial_update_file(pox_c, bas_c), can); + } + free(pox_c); + } + } + } + + if ( closedir(rid_u) < 0 ) { + u3l_log("error closing initial directory %s: %s\r\n", + pax_c, strerror(errno)); + } + + return can; +} + +/* u3_unix_initial_into_card(): create initial filesystem sync card. +*/ +u3_noun +u3_unix_initial_into_card(c3_c* arv_c) +{ + u3_noun can = _unix_initial_update_dir(arv_c, arv_c); + + return u3nc(u3nt(u3_blip, c3__sync, u3_nul), + u3nq(c3__into, u3_nul, c3y, can)); +} + +/* _unix_sync_file(): sync file to unix +*/ +static void +_unix_sync_file(u3_pier *pir_u, u3_udir* par_u, u3_noun nam, u3_noun ext, u3_noun mim) +{ + c3_assert( par_u ); + c3_assert( c3y == par_u->dir ); + + // form file path + + c3_c* nam_c = u3r_string(nam); + c3_c* ext_c = u3r_string(ext); + c3_w par_w = strlen(par_u->pax_c); + c3_w nam_w = strlen(nam_c); + c3_w ext_w = strlen(ext_c); + c3_c* pax_c = c3_malloc(par_w + 1 + nam_w + 1 + ext_w + 1); + + strncpy(pax_c, par_u->pax_c, par_w); + pax_c[par_w] = '/'; + strncpy(pax_c + par_w + 1, nam_c, nam_w); + pax_c[par_w + 1 + nam_w] = '.'; + strncpy(pax_c + par_w + 1 + nam_w + 1, ext_c, ext_w); + pax_c[par_w + 1 + nam_w + 1 + ext_w] = '\0'; + + free(nam_c); free(ext_c); + u3z(nam); u3z(ext); + + // check whether we already know about this file + + u3_unod* nod_u; + for ( nod_u = par_u->kid_u; + ( nod_u && + ( c3y == nod_u->dir || + 0 != strcmp(nod_u->pax_c, pax_c) ) ); + nod_u = nod_u->nex_u ) + { } + + // apply change + + if ( u3_nul == mim ) { + if ( nod_u ) { + u3z(_unix_free_node(pir_u, nod_u)); + } + } + else { + + if ( !nod_u ) { + c3_w gum_w = _unix_write_file_hard(pax_c, u3k(u3t(mim))); + u3_ufil* fil_u = c3_malloc(sizeof(u3_ufil)); + _unix_watch_file(pir_u, fil_u, par_u, pax_c); + fil_u->gum_w = gum_w; + goto _unix_sync_file_out; + } + else { + _unix_write_file_soft((u3_ufil*) nod_u, u3k(u3t(mim))); + } + } + + free(pax_c); + +_unix_sync_file_out: + u3z(mim); +} + +/* _unix_sync_change(): sync single change to unix +*/ +static void +_unix_sync_change(u3_pier *pir_u, u3_udir* dir_u, u3_noun pax, u3_noun mim) +{ + c3_assert( c3y == dir_u->dir ); + + if ( c3n == u3du(pax) ) { + if ( u3_nul == pax ) { + u3l_log("can't sync out file as top-level, strange\r\n"); + } + else { + u3l_log("sync out: bad path\r\n"); + } + u3z(pax); u3z(mim); + return; + } + else if ( c3n == u3du(u3t(pax)) ) { + u3l_log("can't sync out file as top-level, strangely\r\n"); + u3z(pax); u3z(mim); + } + else { + u3_noun i_pax = u3h(pax); + u3_noun t_pax = u3t(pax); + u3_noun it_pax = u3h(t_pax); + u3_noun tt_pax = u3t(t_pax); + + if ( u3_nul == tt_pax ) { + _unix_sync_file(pir_u, dir_u, u3k(i_pax), u3k(it_pax), mim); + } + else { + c3_c* nam_c = u3r_string(i_pax); + c3_w pax_w = strlen(dir_u->pax_c); + u3_unod* nod_u; + + for ( nod_u = dir_u->kid_u; + ( nod_u && + ( c3n == nod_u->dir || + 0 != strcmp(nod_u->pax_c + pax_w + 1, nam_c) ) ); + nod_u = nod_u->nex_u ) + { } + + if ( !nod_u ) { + nod_u = c3_malloc(sizeof(u3_udir)); + _unix_create_dir((u3_udir*) nod_u, dir_u, u3k(i_pax)); + } + + if ( c3n == nod_u->dir ) { + u3l_log("weird, we got a file when we weren't expecting to\r\n"); + c3_assert(0); + } + + _unix_sync_change(pir_u, (u3_udir*) nod_u, u3k(t_pax), mim); + } + } + u3z(pax); +} + +/* _unix_sync_ergo(): sync list of changes to unix +*/ +static void +_unix_sync_ergo(u3_pier *pir_u, u3_umon* mon_u, u3_noun can) +{ + u3_noun nac = can; + u3_noun nam = u3i_string(mon_u->nam_c); + + while ( u3_nul != nac) { + _unix_sync_change(pir_u, &mon_u->dir_u, + u3nc(u3k(nam), u3k(u3h(u3h(nac)))), + u3k(u3t(u3h(nac)))); + nac = u3t(nac); + } + + u3z(nam); + u3z(can); +} + +/* u3_unix_ef_dirk(): commit mount point +*/ +void +u3_unix_ef_dirk(u3_pier *pir_u, u3_noun mon) +{ + _unix_commit_mount_point(pir_u, mon); +} + +/* u3_unix_ef_ergo(): update filesystem from urbit +*/ +void +u3_unix_ef_ergo(u3_pier *pir_u, u3_noun mon, u3_noun can) +{ + u3_umon* mon_u = _unix_get_mount_point(pir_u, mon); + + _unix_sync_ergo(pir_u, mon_u, can); +} + +/* u3_unix_ef_ogre(): delete mount point +*/ +void +u3_unix_ef_ogre(u3_pier *pir_u, u3_noun mon) +{ + _unix_delete_mount_point(pir_u, mon); +} + +/* u3_unix_ef_hill(): enumerate mount points +*/ +void +u3_unix_ef_hill(u3_pier *pir_u, u3_noun hil) +{ + u3_noun mon; + for ( mon = hil; c3y == u3du(mon); mon = u3t(mon) ) { + u3_umon* mon_u = _unix_get_mount_point(pir_u, u3k(u3h(mon))); + _unix_scan_mount_point(pir_u, mon_u); + } + u3z(hil); +} + +/* u3_unix_io_init(): initialize unix sync. +*/ +void +u3_unix_io_init(u3_pier *pir_u) +{ + u3_unix* unx_u = pir_u->unx_u; + + unx_u->mon_u = NULL; + + unx_u->alm = c3n; + unx_u->dyr = c3n; +} + +/* u3_unix_acquire(): acquire a lockfile, killing anything that holds it. +*/ +static void +u3_unix_acquire(c3_c* pax_c) +{ + c3_c* paf_c = _unix_down(pax_c, ".vere.lock"); + c3_w pid_w; + FILE* loq_u; + + if ( NULL != (loq_u = fopen(paf_c, "r")) ) { + if ( 1 != fscanf(loq_u, "%" SCNu32, &pid_w) ) { + u3l_log("lockfile %s is corrupt!\n", paf_c); + kill(getpid(), SIGTERM); + sleep(1); c3_assert(0); + } + else if (pid_w != getpid()) { + c3_w i_w; + + if ( -1 != kill(pid_w, SIGTERM) ) { + u3l_log("unix: stopping process %d, live in %s...\n", + pid_w, pax_c); + + for ( i_w = 0; i_w < 16; i_w++ ) { + sleep(1); + if ( -1 == kill(pid_w, SIGTERM) ) { + break; + } + } + if ( 16 == i_w ) { + for ( i_w = 0; i_w < 16; i_w++ ) { + if ( -1 == kill(pid_w, SIGKILL) ) { + break; + } + sleep(1); + } + } + if ( 16 == i_w ) { + u3l_log("process %d seems unkillable!\n", pid_w); + c3_assert(0); + } + u3l_log("unix: stopped old process %u\n", pid_w); + } + } + fclose(loq_u); + unlink(paf_c); + } + + loq_u = fopen(paf_c, "w"); + fprintf(loq_u, "%u\n", getpid()); + + { + c3_i fid_i = fileno(loq_u); +#if defined(U3_OS_linux) + fdatasync(fid_i); +#elif defined(U3_OS_osx) + fcntl(fid_i, F_FULLFSYNC); +#elif defined(U3_OS_bsd) + fsync(fid_i); +#else +# error "port: datasync" +#endif + } + fclose(loq_u); + free(paf_c); +} + +/* u3_unix_release(): release a lockfile. +*/ +static void +u3_unix_release(c3_c* pax_c) +{ + c3_c* paf_c = _unix_down(pax_c, ".vere.lock"); + + unlink(paf_c); + free(paf_c); +} + +/* u3_unix_ef_bake(): initial effects for new process. +*/ +void +u3_unix_ef_bake(u3_pier *pir_u) +{ + u3_pier_work(pir_u, + u3nt(u3_blip, c3__boat, u3_nul), + u3nc(c3__boat, u3_nul)); +} + +/* u3_unix_ef_look(): update the root. +*/ +void +u3_unix_ef_look(u3_pier *pir_u, u3_noun all) +{ + if ( c3y == pir_u->unx_u->dyr ) { + pir_u->unx_u->dyr = c3n; + u3_umon* mon_u; + + for ( mon_u = pir_u->unx_u->mon_u; mon_u; mon_u = mon_u->nex_u ) { + _unix_update_mount(pir_u, mon_u, all); + } + } +} + +/* u3_unix_io_talk(): start listening for fs events. +*/ +void +u3_unix_io_talk(u3_pier *pir_u) +{ + u3_unix_acquire(pir_u->pax_c); +} + +/* u3_unix_io_exit(): terminate unix I/O. +*/ +void +u3_unix_io_exit(u3_pier *pir_u) +{ + u3_unix_release(pir_u->pax_c); +} diff --git a/pkg/hs/vere/notes/c/walk.c b/pkg/hs/vere/notes/c/walk.c new file mode 100644 index 000000000..e3af728b2 --- /dev/null +++ b/pkg/hs/vere/notes/c/walk.c @@ -0,0 +1,334 @@ +/* vere/walk.c +** +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include "vere/vere.h" + + /* |% + ** ++ arch :: fs node + ** $% [& p=@uvI q=*] :: file, hash/data + ** [| p=(map ,@ta arch)] :: directory + ** == :: + ** -- + */ + +#if 0 +static u3_noun +_walk_ok(u3_noun nod) +{ + u3_noun don = u3n_mung(u3k(u2A->toy.arch), u3k(nod)); + + if ( c3n == u3_sing(nod, don) ) { + c3_assert(0); + } + u3z(don); + return nod; +} +#endif + +/* u3_walk_safe(): load file or 0. +*/ +u3_noun +u3_walk_safe(c3_c* pas_c) +{ + struct stat buf_b; + c3_i fid_i = open(pas_c, O_RDONLY, 0644); + c3_w fln_w, red_w; + c3_y* pad_y; + + if ( (fid_i < 0) || (fstat(fid_i, &buf_b) < 0) ) { + // u3l_log("%s: %s\n", pas_c, strerror(errno)); + return 0; + } + fln_w = buf_b.st_size; + pad_y = c3_malloc(buf_b.st_size); + + red_w = read(fid_i, pad_y, fln_w); + close(fid_i); + + if ( fln_w != red_w ) { + free(pad_y); + return 0; + } + else { + u3_noun pad = u3i_bytes(fln_w, (c3_y *)pad_y); + free(pad_y); + + return pad; + } +} + +/* u3_walk_load(): load file or bail. +*/ +u3_noun +u3_walk_load(c3_c* pas_c) +{ + struct stat buf_b; + c3_i fid_i = open(pas_c, O_RDONLY, 0644); + c3_w fln_w, red_w; + c3_y* pad_y; + + if ( (fid_i < 0) || (fstat(fid_i, &buf_b) < 0) ) { + u3l_log("%s: %s\n", pas_c, strerror(errno)); + return u3m_bail(c3__fail); + } + fln_w = buf_b.st_size; + pad_y = c3_malloc(buf_b.st_size); + + red_w = read(fid_i, pad_y, fln_w); + close(fid_i); + + if ( fln_w != red_w ) { + free(pad_y); + return u3m_bail(c3__fail); + } + else { + u3_noun pad = u3i_bytes(fln_w, (c3_y *)pad_y); + free(pad_y); + + return pad; + } +} + +/* _walk_mkdirp(): recursively make directories in pax at bas_c (RETAIN) +*/ +static void +_walk_mkdirp(c3_c* bas_c, u3_noun pax) +{ + c3_c* pax_c; + c3_y* waq_y; + c3_w pax_w, fas_w, len_w; + + if ( u3_nul == pax ) { + return; + } + + pax_w = u3r_met(3, u3h(pax)); + fas_w = strlen(bas_c); + len_w = 1 + fas_w + pax_w; + + pax_c = c3_malloc(1 + len_w); + strncpy(pax_c, bas_c, len_w); + pax_c[fas_w] = '/'; + waq_y = (void*)(1 + pax_c + fas_w); + u3r_bytes(0, pax_w, waq_y, u3h(pax)); + pax_c[len_w] = '\0'; + + if ( 0 != mkdir(pax_c, 0755) && EEXIST != errno ) { + u3l_log("error mkdiring %s: %s\n", pax_c, strerror(errno)); + u3m_bail(c3__fail); + } + + _walk_mkdirp(pax_c, u3t(pax)); + free(pax_c); +} + +/* u3_walk_save(): save file or bail. +*/ +void +u3_walk_save(c3_c* pas_c, u3_noun tim, u3_atom pad, c3_c* bas_c, u3_noun pax) +{ + c3_i fid_i = open(pas_c, O_WRONLY | O_CREAT | O_TRUNC, 0666); + c3_w fln_w, rit_w; + c3_y* pad_y; + + if ( fid_i < 0 ) { + if ( ENOENT == errno && u3_nul != pax ) { + _walk_mkdirp(bas_c, pax); + return u3_walk_save(pas_c, tim, pad, 0, u3_nul); + } + + u3l_log("%s: %s\n", pas_c, strerror(errno)); + u3m_bail(c3__fail); + } + + fln_w = u3r_met(3, pad); + pad_y = c3_malloc(fln_w); + u3r_bytes(0, fln_w, pad_y, pad); + u3z(pad); + u3z(pax); + + rit_w = write(fid_i, pad_y, fln_w); + close(fid_i); + free(pad_y); + + if ( rit_w != fln_w ) { + u3l_log("%s: %s\n", pas_c, strerror(errno)); + u3m_bail(c3__fail); + } + + if ( 0 != tim ) { + struct timeval tim_tv[2]; + + u3_time_out_tv(&tim_tv[0], u3k(tim)); + u3_time_out_tv(&tim_tv[1], tim); + + utimes(pas_c, tim_tv); + } +} + +/* _walk_in(): inner loop of _walk(), producing map. +*/ +static u3_noun +_walk_in(const c3_c* dir_c, c3_w len_w) +{ + DIR* dir_d = opendir(dir_c); + u3_noun map = u3_nul; + + if ( !dir_d ) { + return u3_nul; + } + else while ( 1 ) { + struct dirent ent_n; + struct dirent* out_n; + + if ( u3_readdir_r(dir_d, &ent_n, &out_n) != 0 ) { + u3l_log("%s: %s\n", dir_c, strerror(errno)); + break; + } + else if ( !out_n ) { + break; + } + else if ( !strcmp(out_n->d_name, ".") || + !strcmp(out_n->d_name, "..") || + ('~' == out_n->d_name[0]) || + ('.' == out_n->d_name[0]) ) // XX restricts some spans + { + continue; + } + else { + c3_c* fil_c = out_n->d_name; + c3_w lef_w = len_w + 1 + strlen(fil_c); + c3_c* pat_c = c3_malloc(lef_w + 1); + struct stat buf_b; + + strncpy(pat_c, dir_c, lef_w); + pat_c[len_w] = '/'; + strncpy(pat_c + len_w + 1, fil_c, lef_w); + pat_c[lef_w] = '\0'; + + if ( 0 != stat(pat_c, &buf_b) ) { + free(pat_c); + } else { + u3_noun tim = c3_stat_mtime(&buf_b); + + if ( !S_ISDIR(buf_b.st_mode) ) { + c3_c* dot_c = strrchr(fil_c, '.'); + c3_c* nam_c = strdup(fil_c); + c3_c* ext_c = strdup(dot_c + 1); + + nam_c[dot_c - fil_c] = 0; + { + u3_noun nam = u3i_string(nam_c); + u3_noun ext = u3i_string(ext_c); + u3_noun get = u3kdb_get(u3k(map), u3k(nam)); + u3_noun dat = u3_walk_load(pat_c); + u3_noun hax; + + if ( !strcmp("noun", ext_c) ) { + dat = u3ke_cue(dat); + } + hax = u3do("sham", u3k(dat)); + if ( u3_none == get ) { get = u3_nul; } + + get = u3kdb_put(get, ext, u3nt(c3y, hax, dat)); + map = u3kdb_put(map, nam, u3nc(c3n, get)); + } + free(nam_c); + free(ext_c); + } + else { + u3_noun dir = _walk_in(pat_c, lef_w); + + if ( u3_nul != dir ) { + map = u3kdb_put + (map, u3i_string(fil_c), u3nc(c3n, dir)); + } + else u3z(tim); + } + free(pat_c); + } + } + } + closedir(dir_d); + return map; +} + +/* u3_walk(): traverse `dir_c` to produce an arch, updating `old`. +*/ +u3_noun +u3_walk(const c3_c* dir_c, u3_noun old) +{ + // XX - obviously, cheaper to update old data. + u3z(old); + { + struct stat buf_b; + + if ( 0 != stat(dir_c, &buf_b) ) { + u3l_log("can't stat %s\n", dir_c); + // return u3m_bail(c3__fail); + c3_assert(0); + } + else { + return u3nc(c3n, + _walk_in(dir_c, strlen(dir_c))); + } + } +} + +/* u3_path(): C unix path in computer for file or directory. +*/ +c3_c* +u3_path(c3_o fyl, u3_noun pax) +{ + c3_w len_w; + c3_c *pas_c; + + // measure + // + len_w = strlen(u3_Local); + { + u3_noun wiz = pax; + + while ( u3_nul != wiz ) { + len_w += (1 + u3r_met(3, u3h(wiz))); + wiz = u3t(wiz); + } + } + + // cut + // + pas_c = c3_malloc(len_w + 1); + strncpy(pas_c, u3_Local, len_w); + pas_c[len_w] = '\0'; + { + u3_noun wiz = pax; + c3_c* waq_c = (pas_c + strlen(pas_c)); + + while ( u3_nul != wiz ) { + c3_w tis_w = u3r_met(3, u3h(wiz)); + + if ( (c3y == fyl) && (u3_nul == u3t(wiz)) ) { + *waq_c++ = '.'; + } else *waq_c++ = '/'; + + u3r_bytes(0, tis_w, (c3_y*)waq_c, u3h(wiz)); + waq_c += tis_w; + + wiz = u3t(wiz); + } + *waq_c = 0; + } + u3z(pax); + return pas_c; +} diff --git a/pkg/hs/vere/notes/c/worker.c b/pkg/hs/vere/notes/c/worker.c new file mode 100644 index 000000000..1a37ca775 --- /dev/null +++ b/pkg/hs/vere/notes/c/worker.c @@ -0,0 +1,947 @@ +/* worker/main.c +** +** the main loop of a worker process. +*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "all.h" +#include + + typedef struct _u3_worker { + c3_w len_w; // boot sequence length + u3_noun roe; // lifecycle formulas + c3_d sen_d; // last event requested + c3_d dun_d; // last event processed + c3_l mug_l; // hash of state + c3_d key_d[4]; // disk key + u3_moat inn_u; // message input + u3_mojo out_u; // message output + c3_c* dir_c; // execution directory (pier) + } u3_worker; + static u3_worker u3V; + +/* +:: worker to daemon protocol +:: +|% +:: +plea: from worker to daemon +:: ++$ plea + $% :: status on startup + :: + $: %play + $= p + :: ~ if no snapshot + :: + %- unit + :: p: event number expected + :: q: mug of kernel + :: r: identity, fake flag + :: + [p=@ q=@ r=[our=@p fak=?]] + == + :: event executed unchanged (in response to %work) + :: + $: %done + :: p: event number + :: q: mug of kernel + :: r: effects + :: + [p=@ q=@ r=(list ovum)] + == + :: replace event and retry (in response to %work) + :: + $: %work + :: p: event number + :: q: mug of kernel + :: r: replacement event (at date) + :: + [p=@ q=@ r=(pair date ovum)] + == + :: sends a line to stderr while computing event + :: + $: %stdr + :: p: event number + :: q: output cord + :: + [p=@ q=cord] + == + :: send slog hint while computing event + :: + $: %slog + :: p: event number + :: q: priority + :: r: output tank + :: + [p=@ q=@ r=tank] + == == +:: +writ: from daemon to worker +:: ++$ writ + $% :: prepare to boot + :: + :: p: identity + :: q: fake? + :: r: number of boot formulas + :: + [%boot p=@p q=? r=@] + :: exit immediately + :: + :: p: exit code + :: + [%exit p=@] + :: save snapshot to disk + :: + :: p: event number + :: + [%save p=@] + :: execute event + :: + $: %work + :: p: event number + :: q: a jammed noun [mug [date ovum]] + :: + [p=@ q=@] + == == +-- +*/ + +/* _worker_space(): print n spaces. +*/ +void _worker_space(FILE* fil_u, c3_w n) +{ + for (; n > 0; n--) + (fprintf(fil_u," ")); +} + +/* _worker_print_memory(): print memory amount. +** +** Helper for _worker_prof(), just an un-captioned u3a_print_memory(). +*/ +void +_worker_print_memory(FILE* fil_u, c3_w wor_w) +{ + c3_w byt_w = (wor_w * 4); + c3_w gib_w = (byt_w / 1000000000); + c3_w mib_w = (byt_w % 1000000000) / 1000000; + c3_w kib_w = (byt_w % 1000000) / 1000; + c3_w bib_w = (byt_w % 1000); + + if ( gib_w ) { + (fprintf(fil_u, "GB/%d.%03d.%03d.%03d\r\n", + gib_w, mib_w, kib_w, bib_w)); + } + else if ( mib_w ) { + (fprintf(fil_u, "MB/%d.%03d.%03d\r\n", mib_w, kib_w, bib_w)); + } + else if ( kib_w ) { + (fprintf(fil_u, "KB/%d.%03d\r\n", kib_w, bib_w)); + } + else { + (fprintf(fil_u, "B/%d\r\n", bib_w)); + } +} + +/* _worker_prof(): print memory profile. RETAIN. +*/ +c3_w +_worker_prof(FILE* fil_u, c3_w den, u3_noun mas) +{ + c3_w tot_w = 0; + u3_noun h_mas, t_mas; + + if ( c3n == u3r_cell(mas, &h_mas, &t_mas) ) { + _worker_space(fil_u, den); + fprintf(fil_u, "mistyped mass\r\n"); + return tot_w; + } + else if ( _(u3du(h_mas)) ) { + _worker_space(fil_u, den); + fprintf(fil_u, "mistyped mass head\r\n"); + { + c3_c* lab_c = u3m_pretty(h_mas); + fprintf(fil_u, "h_mas: %s", lab_c); + free(lab_c); + } + return tot_w; + } + else { + _worker_space(fil_u, den); + + { + c3_c* lab_c = u3m_pretty(h_mas); + fprintf(fil_u, "%s: ", lab_c); + free(lab_c); + } + + u3_noun it_mas, tt_mas; + + if ( c3n == u3r_cell(t_mas, &it_mas, &tt_mas) ) { + fprintf(fil_u, "mistyped mass tail\r\n"); + return tot_w; + } + else if ( c3y == it_mas ) { + tot_w += u3a_mark_noun(tt_mas); + _worker_print_memory(fil_u, tot_w); + +#if 1 + /* The basic issue here is that tt_mas is included in .sac + * (the whole profile), so they can't both be roots in the + * normal sense. When we mark .sac later on, we want tt_mas + * to appear unmarked, but its children should be already + * marked. + */ + if ( _(u3a_is_dog(tt_mas)) ) { + u3a_box* box_u = u3a_botox(u3a_to_ptr(tt_mas)); +#ifdef U3_MEMORY_DEBUG + if ( 1 == box_u->eus_w ) { + box_u->eus_w = 0xffffffff; + } + else { + box_u->eus_w -= 1; + } +#else + if ( -1 == (c3_w)box_u->use_w ) { + box_u->use_w = 0x80000000; + } + else { + box_u->use_w += 1; + } +#endif + } +#endif + + return tot_w; + } + else if ( c3n == it_mas ) { + fprintf(fil_u, "\r\n"); + + while ( _(u3du(tt_mas)) ) { + tot_w += _worker_prof(fil_u, den+2, u3h(tt_mas)); + tt_mas = u3t(tt_mas); + } + + _worker_space(fil_u, den); + fprintf(fil_u, "--"); + _worker_print_memory(fil_u, tot_w); + + return tot_w; + + } + else { + _worker_space(fil_u, den); + fprintf(fil_u, "mistyped (strange) mass tail\r\n"); + return tot_w; + } + } +} + +/* _worker_grab(): garbage collect, checking for profiling. RETAIN. +*/ +static void +_worker_grab(u3_noun sac, u3_noun ovo, u3_noun vir) +{ + if ( u3_nul == sac) { + if ( u3C.wag_w & (u3o_debug_ram | u3o_check_corrupt) ) { + u3m_grab(sac, ovo, vir, u3_none); + } + } + else { + c3_w usr_w = 0, man_w = 0, sac_w = 0, ova_w = 0, roe_w = 0, vir_w = 0; + + FILE* fil_u; + +#ifdef U3_MEMORY_LOG + { + u3_noun wen = u3dc("scot", c3__da, u3k(u3A->now)); + c3_c* wen_c = u3r_string(wen); + + c3_c nam_c[2048]; + snprintf(nam_c, 2048, "%s/.urb/put/mass", u3P.dir_c); + + struct stat st; + if ( -1 == stat(nam_c, &st) ) { + mkdir(nam_c, 0700); + } + + c3_c man_c[2048]; + snprintf(man_c, 2048, "%s/%s.txt", nam_c, wen_c); + + fil_u = fopen(man_c, "w"); + fprintf(fil_u, "%s\r\n", wen_c); + + free(wen_c); + u3z(wen); + } +#else + { + fil_u = stderr; + } +#endif + + c3_assert( u3R == &(u3H->rod_u) ); + + fprintf(fil_u, "\r\n"); + usr_w = _worker_prof(fil_u, 0, sac); + u3a_print_memory(fil_u, "total userspace", usr_w); + + man_w = u3m_mark(fil_u); + + sac_w = u3a_mark_noun(sac); + u3a_print_memory(fil_u, "space profile", sac_w); + + ova_w = u3a_mark_noun(ovo); + u3a_print_memory(fil_u, "event", ova_w); + + roe_w = u3a_mark_noun(u3V.roe); + u3a_print_memory(fil_u, "lifecycle events", roe_w); + + vir_w = u3a_mark_noun(vir); + u3a_print_memory(fil_u, "effects", vir_w); + + u3a_print_memory(fil_u, "total marked", usr_w + man_w + sac_w + ova_w + vir_w); + + u3a_print_memory(fil_u, "sweep", u3a_sweep()); + +#ifdef U3_MEMORY_LOG + { + fclose(fil_u); + } +#endif + } +} + +/* _worker_fail(): failure stub. +*/ +static void +_worker_fail(void* vod_p, const c3_c* wut_c) +{ + u3l_log("work: fail: %s\r\n", wut_c); + exit(1); +} + +/* _worker_send(): send result back to daemon. +*/ +static void +_worker_send(u3_noun job) +{ + u3_newt_write(&u3V.out_u, u3ke_jam(job), 0); +} + +/* _worker_send_replace(): send replacement job back to daemon. +*/ +static void +_worker_send_replace(c3_d evt_d, u3_noun job) +{ + u3l_log("worker_send_replace %" PRIu64 " %s\r\n", + evt_d, + u3r_string(u3h(u3t(u3t(job))))); + + _worker_send(u3nt(c3__work, + u3i_chubs(1, &evt_d), + u3ke_jam(u3nc(u3V.mug_l, job)))); +} + +/* _worker_send_complete(): report completion. +*/ +static void +_worker_send_complete(u3_noun vir) +{ + _worker_send(u3nq(c3__done, + u3i_chubs(1, &u3V.dun_d), + u3V.mug_l, + vir)); +} + +/* _worker_send_stdr(): send stderr output +*/ +static void +_worker_send_stdr(c3_c* str_c) +{ + _worker_send(u3nt(c3__stdr, u3i_chubs(1, &u3V.sen_d), u3i_string(str_c))); +} + +/* _worker_send_slog(): send hint output (hod is [priority tank]). +*/ +static void +_worker_send_slog(u3_noun hod) +{ + _worker_send(u3nt(c3__slog, u3i_chubs(1, &u3V.sen_d), hod)); +} + +/* _worker_lame(): event failed, replace with error event. +*/ +static void +_worker_lame(c3_d evt_d, u3_noun now, u3_noun ovo, u3_noun why, u3_noun tan) +{ + u3_noun rep; + u3_noun wir, tag, cad; + + u3x_trel(ovo, &wir, &tag, &cad); + + // a deterministic error (%exit) in a network packet (%hear) + // generates a negative-acknowlegement attempt (%hole). + // + // A comment from the old implementation: + // There should be a separate path for crypto failures, + // to prevent timing attacks, but isn't right now. To deal + // with a crypto failure, just drop the packet. + // + if ( (c3__hear == tag) && (c3__exit == why) ) { + rep = u3nt(u3k(wir), c3__hole, u3k(cad)); + } + // failed event notifications (%crud) are replaced with + // an even more generic notifications, on a generic arvo wire. + // N.B this must not be allowed to fail! + // + // [%warn original-event-tag=@tas combined-trace=(list tank)] + // + else if ( c3__crud == tag ) { + u3_noun lef = u3nc(c3__leaf, u3i_tape("crude crashed!")); + u3_noun nat = u3kb_weld(u3k(u3t(cad)), u3nc(lef, u3k(tan))); + rep = u3nc(u3nt(u3_blip, c3__arvo, u3_nul), + u3nt(c3__warn, u3k(u3h(cad)), nat)); + } + // failed failure failing fails + // + else if ( c3__warn == tag ) { + _worker_fail(0, "%warn replacement event failed"); + c3_assert(0); + } + // failure notifications are sent on the same wire + // + // [%crud event-tag=@tas event-trace=(list tank)] + // + else { + // prepend failure mote to tank + // + u3_noun lef = u3nc(c3__leaf, u3kb_weld(u3i_tape("bail: "), + u3qc_rip(3, why))); + u3_noun nat = u3kb_weld(u3k(tan), u3nc(lef, u3_nul)); + rep = u3nc(u3k(wir), u3nt(c3__crud, u3k(tag), nat)); + } + + _worker_send_replace(evt_d, u3nc(now, rep)); + + u3z(ovo); u3z(why); u3z(tan); +} + +/* _worker_sure(): event succeeded, report completion. +*/ +static void +_worker_sure(u3_noun ovo, u3_noun vir, u3_noun cor) +{ + u3z(u3A->roc); + u3A->roc = cor; + u3A->ent_d = u3V.dun_d; + u3V.mug_l = u3r_mug(u3A->roc); + + u3_noun sac = u3_nul; + + // intercept |mass, observe |reset + // + { + u3_noun riv = vir; + c3_w i_w = 0; + + while ( u3_nul != riv ) { + u3_noun fec = u3t(u3h(riv)); + + // assumes a max of one %mass effect per event + // + if ( c3__mass == u3h(fec) ) { + // save a copy of the %mass data + // + sac = u3k(u3t(fec)); + // replace the %mass data with ~ + // + // For efficient transmission to daemon. + // + riv = u3kb_weld(u3qb_scag(i_w, vir), + u3nc(u3nt(u3k(u3h(u3h(riv))), c3__mass, u3_nul), + u3qb_slag(1 + i_w, vir))); + u3z(vir); + vir = riv; + break; + } + + // reclaim memory from persistent caches on |reset + // + if ( c3__vega == u3h(fec) ) { + u3m_reclaim(); + } + + riv = u3t(riv); + i_w++; + } + } + + // XX this runs on replay too + // + _worker_grab(sac, ovo, vir); + _worker_send_complete(vir); + + u3z(sac); u3z(ovo); +} + +/* _worker_work_live(): apply event. +*/ +static void +_worker_work_live(c3_d evt_d, u3_noun job) +{ + u3_noun now, ovo, gon; + u3_noun last_date; + + c3_assert(evt_d == u3V.dun_d + 1ULL); + u3V.sen_d = evt_d; + + u3x_cell(job, &now, &ovo); + + last_date = u3A->now; + u3A->now = u3k(now); + +#ifdef U3_EVENT_TIME_DEBUG + { + struct timeval b4, f2, d0; + gettimeofday(&b4, 0); + + if ( c3__belt != u3h(u3t(ovo)) ) { + c3_c* txt_c = u3r_string(u3h(u3t(ovo))); + + u3l_log("work: %s (%" PRIu64 ") live\r\n", txt_c, evt_d); + } + } +#endif + + gon = u3m_soft(0, u3v_poke, u3k(ovo)); + +#ifdef U3_EVENT_TIME_DEBUG + { + c3_c* txt_c = u3r_string(u3h(u3t(ovo))); + c3_w ms_w; + c3_w clr_w; + + gettimeofday(&f2, 0); + timersub(&f2, &b4, &d0); + ms_w = (d0.tv_sec * 1000) + (d0.tv_usec / 1000); + clr_w = ms_w > 1000 ? 1 : ms_w < 100 ? 2 : 3; // red, green, yellow + if (c3__belt != u3h(u3t(ovo)) || clr_w != 2) { + u3l_log("\x1b[3%dm%%%s (%" PRIu64 ") %4d.%02dms\x1b[0m\n", + clr_w, txt_c, evt_d, ms_w, + (int) (d0.tv_usec % 1000) / 10); + } + free(txt_c); + } +#endif + + if ( u3_blip != u3h(gon) ) { + // event rejected + // + u3V.sen_d = u3V.dun_d; + // restore previous time + // + u3_noun nex = u3A->now; + u3A->now = last_date; + + u3_noun why, tan; + u3x_cell(gon, &why, &tan); + + u3k(ovo); u3k(why); u3k(tan); + u3z(gon); u3z(job); + + _worker_lame(evt_d, nex, ovo, why, tan); + } + else { + // event accepted + // + u3V.dun_d = u3V.sen_d; + u3z(last_date); + + // vir/(list ovum) list of effects + // cor/arvo arvo core + // + u3_noun vir, cor; + u3x_trel(gon, 0, &vir, &cor); + + u3k(ovo); u3k(vir); u3k(cor); + u3z(gon); u3z(job); + + _worker_sure(ovo, vir, cor); + + // reclaim memory from persistent caches periodically + // + // XX this is a hack to work around the fact that + // the bytecode caches grow rapidly and are not + // able to be simply capped (due to internal posts). + // + if ( 0 == (evt_d % 1000ULL) ) { + u3m_reclaim(); + } + } +} + +/* _worker_work_boot(): apply initial-stage event. +*/ +static void +_worker_work_boot(c3_d evt_d, u3_noun job) +{ + // here we asset on u3V.sen_d, because u3V.dun_d isn't set until + // after u3V.sen_d == u3V.len_w (ie, after the lifecycle evaluation) + // + c3_assert(evt_d == u3V.sen_d + 1ULL); + u3V.sen_d = evt_d; + + u3V.roe = u3nc(job, u3V.roe); + + u3l_log("work: (%" PRIu64 ")| boot\r\n", evt_d); + + if ( u3V.len_w == evt_d ) { + u3_noun eve = u3kb_flop(u3V.roe); + u3V.roe = u3_nul; + + u3l_log("work: (%" PRIu64 ")| pill: %x\r\n", evt_d, u3r_mug(eve)); + + if ( c3n == u3v_boot(eve) ) { + u3l_log("work: boot failed: invalid sequence (from pill)\r\n"); + exit(1); + } + + u3V.dun_d = evt_d; + u3V.mug_l = u3r_mug(u3A->roc); + u3A->ent_d = u3V.dun_d; + + u3l_log("work: (%" PRIu64 ")| core: %x\r\n", evt_d, u3V.mug_l); + } + else { + // prior to the evaluation of the entire lifecycle sequence, + // we simply use the mug of the formula as the kernel mug + // + u3V.mug_l = u3r_mug(job); + } + + _worker_send(u3nq(c3__done, + u3i_chubs(1, &evt_d), + u3V.mug_l, + u3_nul)); +} + +/* _worker_poke_work(): apply event. +*/ +static void +_worker_poke_work(c3_d evt_d, // event number + c3_l mug_l, // mug of state + u3_noun job) // full event +{ + if ( u3C.wag_w & u3o_trace ) { + if ( u3_Host.tra_u.con_w == 0 && u3_Host.tra_u.fun_w == 0 ) { + u3t_trace_open(u3V.dir_c); + } + else if ( u3_Host.tra_u.con_w >= 100000 ) { + u3t_trace_close(); + u3t_trace_open(u3V.dir_c); + } + } + + // Require mugs to match + // + // We use mugs to enforce that %work is always performed against + // the exact kernel we expect it to be. If it isn't, we have either + // event-log corruption or non-determism on replay, or programmer error + // in normal operation. In either case, we immediately exit. + // + if ( u3V.mug_l != mug_l ) { + u3l_log("work: invalid %%work for event %" PRIu64 ".\r\n", evt_d); + u3l_log("work: computed mug is %x but event %" PRIu64 " expected %x.\r\n", + u3V.mug_l, + evt_d, + mug_l); + _worker_fail(0, "bad jar"); + return; + } + + if ( evt_d <= u3V.len_w ) { + c3_c lab_c[8]; + snprintf(lab_c, 8, "boot: %" PRIu64 "", evt_d); + + u3t_event_trace(lab_c, 'B'); + _worker_work_boot(evt_d, job); + u3t_event_trace(lab_c, 'E'); + } + else { + u3_noun wir = u3h(u3t(job)); + u3_noun cad = u3h(u3t(u3t(job))); + + c3_c lab_c[2048]; + snprintf(lab_c, 2048, "event %" PRIu64 ": [%s %s]", evt_d, + u3m_pretty_path(wir), u3m_pretty(cad)); + + u3t_event_trace(lab_c, 'B'); + _worker_work_live(evt_d, job); + u3t_event_trace(lab_c, 'E'); + } +} + +/* _worker_poke_exit(): exit on command. +*/ +static void +_worker_poke_exit(c3_w cod_w) // exit code +{ + if ( u3C.wag_w & u3o_debug_cpu ) { + u3t_damp(); + } + + exit(cod_w); +} + +/* _worker_poke_boot(): prepare to boot. +*/ +static void +_worker_poke_boot(u3_noun who, u3_noun fak, c3_w len_w) +{ + c3_assert( u3_none == u3A->our ); + c3_assert( 0 != len_w ); + + u3A->our = who; + u3A->fak = fak; + u3V.len_w = len_w; +} + +/* _worker_poke(): +*/ +void +_worker_poke(void* vod_p, u3_noun mat) +{ + u3_noun jar = u3ke_cue(mat); + + if ( c3y != u3du(jar) ) { + goto error; + } + else { + switch ( u3h(jar) ) { + default: { + goto error; + } + + case c3__boot: { + u3_noun who, fak, len; + c3_w len_w; + + if ( (c3n == u3r_qual(jar, 0, &who, &fak, &len)) || + (c3n == u3ud(who)) || + (1 < u3r_met(7, who)) || + (c3n == u3ud(fak)) || + (1 < u3r_met(0, fak)) || + (c3n == u3ud(len)) || + (1 < u3r_met(3, len)) ) + { + goto error; + } + + len_w = u3r_word(0, len); + u3k(who); + u3k(fak); + u3z(jar); + + return _worker_poke_boot(who, fak, len_w); + } + + case c3__work: { + u3_noun evt, jammed_entry, mug, job; + c3_d evt_d; + c3_l mug_l; + + if ( (c3n == u3r_trel(jar, 0, &evt, &jammed_entry)) || + (c3n == u3ud(evt)) || + (1 != u3r_met(6, evt)) ) + { + goto error; + } + + u3_noun entry = u3qe_cue(jammed_entry); + if ( (c3y != u3du(entry)) || + (c3n == u3r_cell(entry, &mug, &job)) || + (c3n == u3ud(mug)) || + (1 < u3r_met(5, mug)) ) { + goto error; + } + + evt_d = u3r_chub(0, evt); + mug_l = u3r_word(0, mug); + u3k(job); + u3z(entry); + u3z(jar); + + return _worker_poke_work(evt_d, mug_l, job); + } + + case c3__exit: { + u3_noun cod; + c3_w cod_w; + + if ( (c3n == u3r_cell(jar, 0, &cod)) || + (c3n == u3ud(cod)) || + (1 < u3r_met(3, cod)) ) + { + goto error; + } + + cod_w = u3r_word(0, cod); + u3z(jar); + + return _worker_poke_exit(cod_w); + } + + case c3__save: { + u3_noun evt; + c3_d evt_d; + + if ( (c3n == u3r_cell(jar, 0, &evt)) || + (c3n == u3ud(evt)) ) + { + goto error; + } + + evt_d = u3r_chub(0, evt); + u3z(jar); + + c3_assert( evt_d == u3V.dun_d ); + + return u3e_save(); + } + } + } + + error: { + u3z(jar); + _worker_fail(0, "bad jar"); + } +} + +/* u3_worker_boot(): send startup message to manager. +*/ +void +u3_worker_boot(void) +{ + c3_d nex_d = 1ULL; + u3_noun dat = u3_nul; + + if ( u3_none != u3A->our ) { + u3V.mug_l = u3r_mug(u3A->roc); + nex_d = u3V.dun_d + 1ULL; + dat = u3nc(u3_nul, u3nt(u3i_chubs(1, &nex_d), + u3V.mug_l, + u3nc(u3k(u3A->our), u3k(u3A->fak)))); + + // disable hashboard for fake ships + // + if ( c3y == u3A->fak ) { + u3C.wag_w |= u3o_hashless; + } + + // no boot sequence expected + // + u3V.len_w = 0; + } + + u3l_log("work: play %" PRIu64 "\r\n", nex_d); + + _worker_send(u3nc(c3__play, dat)); +} + +/* main(): main() when run as urbit-worker +*/ +c3_i +main(c3_i argc, c3_c* argv[]) +{ + uv_loop_t* lup_u = uv_default_loop(); + c3_c* dir_c = argv[1]; + c3_c* key_c = argv[2]; + c3_c* wag_c = argv[3]; + + c3_assert(4 == argc); + + memset(&u3V, 0, sizeof(u3V)); + memset(&u3_Host.tra_u, 0, sizeof(u3_Host.tra_u)); + + /* load passkey + */ + { + sscanf(key_c, "%" PRIx64 ":%" PRIx64 ":%" PRIx64 ":%" PRIx64 "", + &u3V.key_d[0], + &u3V.key_d[1], + &u3V.key_d[2], + &u3V.key_d[3]); + } + + /* load runtime config + */ + { + sscanf(wag_c, "%" SCNu32, &u3C.wag_w); + } + + /* load pier directory + */ + { + u3V.dir_c = strdup(dir_c); + } + + /* boot image + */ + { + u3V.sen_d = u3V.dun_d = u3m_boot(dir_c); + u3C.stderr_log_f = _worker_send_stdr; + u3C.slog_f = _worker_send_slog; + } + + /* configure pipe to daemon process + */ + { + c3_i err_i; + + err_i = uv_pipe_init(lup_u, &u3V.inn_u.pyp_u, 0); + c3_assert(!err_i); + uv_pipe_open(&u3V.inn_u.pyp_u, 0); + + err_i = uv_pipe_init(lup_u, &u3V.out_u.pyp_u, 0); + c3_assert(!err_i); + uv_pipe_open(&u3V.out_u.pyp_u, 1); + } + + /* set up writing + */ + u3V.out_u.bal_f = _worker_fail; + + /* start reading + */ + u3V.inn_u.vod_p = &u3V; + u3V.inn_u.pok_f = _worker_poke; + u3V.inn_u.bal_f = _worker_fail; + + u3_newt_read(&u3V.inn_u); + + /* send start request + */ + u3_worker_boot(); + + /* enter loop + */ + uv_run(lup_u, UV_RUN_DEFAULT); + return 0; +} diff --git a/pkg/hs/vere/package.yaml b/pkg/hs/vere/package.yaml index ea9f86ab7..92ba23dde 100644 --- a/pkg/hs/vere/package.yaml +++ b/pkg/hs/vere/package.yaml @@ -20,8 +20,10 @@ dependencies: - classy-prelude - stm - stm-chans + - async - lens + - largeword + - time -executables: - vere: - main: Main.hs +library: + source-dirs: .