(defmodule nemoptera_server
(behaviour gen_server)
(export all))
(defun start_link (org-name slug fossil-path)
(gen_server:start_link 'nemoptera_server (tuple org-name slug fossil-path) '()))
(defun init (args)
(let (((tuple org-name slug fossil-path) args))
;; Import the skin before trap_exit. A finished fossil command exits
;; normally, and a trapped normal exit would be reported to this process.
(case (catch (nemoptera_fossil_repo:configure-web fossil-path))
(`#(ok ,_) 'ok)
(`#(EXIT ,reason)
(logger:warning "repository skin failed: ~p" (list reason)))
(other
(logger:warning "repository skin failed: ~p" (list other))))
(process_flag 'trap_exit 'true)
(case (open-server org-name slug fossil-path 3)
(`#(ok ,port ,portnum)
(nemoptera_registry:put org-name slug portnum)
`#(ok ,(tuple org-name slug fossil-path port portnum)))
(`#(error ,reason) `#(stop ,reason)))))
(defun open-server (org-name slug fossil-path tries)
(let ((bin (nemoptera_config:fossil-bin)))
(if (is_list bin)
(try-open bin org-name slug fossil-path tries)
`#(error #(enoent "fossil executable was not found")))))
(defun try-open (bin org-name slug fossil-path tries)
(let* ((portnum (free-port))
(args (server-args org-name slug fossil-path portnum))
(home (nemoptera_fossil:to-charlist
(filename:absname (nemoptera_config:get 'fossil_home "data/fossil-home")))))
(filelib:ensure_dir (filename:join home "x"))
(let ((result (catch
(open_port (tuple 'spawn_executable (nemoptera_fossil:to-charlist bin))
(list 'stream 'in 'binary 'exit_status 'hide 'stderr_to_stdout
(tuple 'env (list (tuple "FOSSIL_HOME" home)
(tuple "HOME" home)
(tuple "USER" (os:getenv "USER" "nemoptera"))))
(tuple 'args args))))))
(if (is_port result)
(case (wait-ready result portnum 80 #"")
('ok `#(ok ,result ,portnum))
(`#(error ,reason)
(catch (port_close result))
(if (> tries 1)
(try-open bin org-name slug fossil-path (- tries 1))
`#(error ,reason))))
(if (> tries 1)
(try-open bin org-name slug fossil-path (- tries 1))
`#(error #(port-open ,result)))))))
(defun server-args (org-name slug fossil-path portnum)
(let ((base (list "server" "--localhost" "--nojail"
"--port" (integer_to_list portnum)
"--baseurl" (nemoptera_site:repo-base-url org-name slug))))
(lists:append
(if (nemoptera_site:https?)
(lists:append base '("--https"))
base)
(list (nemoptera_fossil:to-charlist (filename:absname fossil-path))))))
(defun wait-ready (port portnum attempts acc)
(if (=:= attempts 0)
`#(error #(timeout ,(binary_to_list acc)))
(receive
(`#(,port #(exit_status ,code))
`#(error #(exit_status ,code ,(binary_to_list acc))))
(`#(,port #(data ,data))
(wait-ready port portnum attempts (iolist_to_binary (list acc data))))
(after 50
(case (gen_tcp:connect "127.0.0.1" portnum
(list 'binary (tuple 'active 'false)) 50)
(`#(ok ,sock)
(gen_tcp:close sock)
'ok)
(_ (wait-ready port portnum (- attempts 1) acc)))))))
(defun free-port ()
(case (gen_tcp:listen 0 (list 'binary
(tuple 'active 'false)
(tuple 'reuseaddr 'true)
(tuple 'ip (tuple 127 0 0 1))))
(`#(ok ,sock)
(let ((result (inet:port sock)))
(gen_tcp:close sock)
(case result
(`#(ok ,port) port)
(_ (+ 20000 (erlang:phash2 (os:timestamp) 20000))))))
(_ (+ 20000 (erlang:phash2 (os:timestamp) 20000)))))
(defun handle_call (_message _from state) `#(reply ok ,state))
(defun handle_cast (_message state) `#(noreply ,state))
(defun handle_info (message state)
(let (((tuple org-name slug _path port _portnum) state))
(case message
(`#(_ #(data ,_)) `#(noreply ,state))
(`#(EXIT ,exited ,reason)
(if (=:= exited port)
(progn
(nemoptera_registry:delete org-name slug)
`#(stop ,(tuple 'port-exited reason) ,state))
`#(noreply ,state)))
(`#(,exited #(exit_status ,code))
(if (=:= exited port)
(progn
(nemoptera_registry:delete org-name slug)
`#(stop ,(tuple 'port-exited code) ,state))
`#(noreply ,state)))
(_ `#(noreply ,state)))))
(defun terminate (_reason state)
(let (((tuple org-name slug _path port _portnum) state))
(catch (port_close port))
(nemoptera_registry:delete org-name slug)
'ok))
(defun code_change (_old state _extra) `#(ok ,state))