talircd/lib/server/connection.ml

open! Import

type t = {
  addr : sockaddr;
  user : Router.user;
  outbox : Irc.Msg.t Lwt_stream.t;
  push_outbox : (Irc.Msg.t option -> unit);
  quit : unit Lwt_condition.t;
}

let make ~(router : Router.t) ~(addr : sockaddr) : t =
  let hostname = match addr with
    | ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
    | ADDR_UNIX path -> path
  in
  let user = Router.User.make router ~hostname in
  let outbox, push_outbox = Lwt_stream.create () in
  {
    addr; user; outbox; push_outbox;
    quit = Lwt_condition.create ();
  }

let quitting t = Lwt_condition.wait t.quit
let outbox t = t.outbox
let send t msg = try t.push_outbox (Some msg) with Lwt_stream.Closed -> ()

let cleanup t =
  t.push_outbox None;
  Router.User.cleanup t.user

(* message handling *)

let require_registered t f =
  if Router.User.is_registered t.user then
    f (Option.get t.user.userinfo)
  else
    `notregistered

(* > user registration *)

let attempt_to_register t =
  match t.user.nick, t.user.userinfo with
  | Some nick, Some _userinfo ->
    begin match Router.User.set_nick t.user nick with
      | `nick_in_use -> `nicknameinuse nick
      | `nick_set ->
        Logs.debug (fun m -> m "init mode: +%a" Irc.Mode.pp t.user.mode);
        (* TODO: set initial mode *)
        `welcome
    end
  | _, _ -> `ok

let on_msg_nick t nick =
  if Router.User.is_registered t.user then
    match Router.User.set_nick t.user nick with
    | `nick_in_use -> `nicknameinuse nick
    | `nick_set -> `ok
  else begin
    t.user.nick <- Some nick;
    attempt_to_register t
  end

let on_msg_user t username modestr realname =
  if Router.User.is_registered t.user then
    `alreadyregistered
  else begin
    (* NB: +iw is automatically set, so it's impossible to actually affect the initial
       mode with the parameter to USER *)
    ignore modestr;
    t.user.userinfo <- Some { username; realname };
    attempt_to_register t
  end

(* > messages and channels *)

let on_msg_privmsg t tgt msg _userinfo =
  match Router.find_user t.user.router tgt with
  | None -> `nosuchnick tgt
  | Some _ ->
    let _ = msg in
    (* TODO: send messages *)
    `tryagain

let on_msg_privmsg t tgt msg = require_registered t (on_msg_privmsg t tgt msg)
    
(* > misc *)

let on_msg_quit t why =
  let why = String.concat " " why in
  Logs.debug (fun m -> m "%a: quit: %S" pp_sockaddr t.addr why);
  Lwt_condition.broadcast t.quit ();
  `ok

(* message sending *)

(* TODO: configure these *)
let srv_host = "irc.tali.software"
let srv_ver = "0.0.0"
let srv_created = "Sun Jan 7 09:58:24 PM EST 2024"
let srv_motd_lines = [
  "MEOW MEOW MEOW MEOW MEOW";
  "meow meow meow meow meow";
  "meowmeowmeowmeowmeowmeow";
]

let rpl t cmd params =
  let prefix = Irc.Msg.Server_prefix srv_host in
  let target = Router.User.nick t.user in
  send t (Irc.Msg.make ~prefix cmd (target :: params))

let rpl_tryagain t cmd = rpl t "263" [cmd; "Please wait a while and try again."]

let rpl_welcome t =
  let who = Irc.Msg.prefix_string (Router.User.prefix t.user) in
  begin
    rpl t "001" [Fmt.str "Welcome to the tali IRC network %s" who];
    rpl t "002" [Fmt.str "Your host is %s, running version %s" srv_host srv_ver];
    rpl t "003" [Fmt.str "This server was created %s" srv_created];
    rpl t "004" [srv_host; srv_ver; "aiwroOs"; "oinvm"];
  end

let rpl_motd t =
  begin 
    rpl t "375" [Fmt.str "- %s Message of the day - " srv_host];
    List.iter (fun ln -> rpl t "372" ["- " ^ ln]) srv_motd_lines;
    rpl t "376" ["End of /MOTD command"];
  end

let err_alreadyregistered t = rpl t "462" ["Unauthorized command (already registered)"]
let err_needmoreparams t cmd = rpl t "461" [cmd; "Not enough parameters"]
let err_nicknameinuse t nick = rpl t "433" [nick; "Nickname is already in use"]
let err_norecipient t cmd = rpl t "411" [Fmt.str "No recipient given (%s)" cmd]
let err_nosuchnick t tgt = rpl t "401" [tgt; "No such nick/channel"]
let err_notexttosend t = rpl t "412" [Fmt.str "No text to send"]
let err_notregistered t = rpl t "451" ["You have not registered"]
let err_unknowncommand t cmd = rpl t "421" [cmd; "Unknown command"]

(* message parsing *)

let on_msg t (msg : Irc.Msg.t) : unit =
  Logs.debug (fun m -> m "%a: %a" pp_sockaddr t.addr Irc.Msg.pp msg);
  let result =
    match msg.command, msg.params with
    | "NICK", new_nick :: _ ->
      on_msg_nick t new_nick
    | "USER", username :: modestr :: _host :: realname :: _ ->
      on_msg_user t username modestr realname
    | "QUIT", why ->
      on_msg_quit t why
    | "PRIVMSG", tgt :: msg :: _ ->
      on_msg_privmsg t tgt msg
    | "PRIVMSG", [_] -> `notexttosend | "PRIVMSG", [] -> `norecipient
    | "NICK", _ | "USER", _ -> `needmoreparams
    | _, _ -> `unknowncommand
  in
  match result with
  | `ok -> ()
  | `welcome -> rpl_welcome t; rpl_motd t
  | `tryagain -> rpl_tryagain t msg.command
  | `alreadyregistered -> err_alreadyregistered t
  | `needmoreparams -> err_needmoreparams t msg.command
  | `nicknameinuse n -> err_nicknameinuse t n    
  | `norecipient -> err_norecipient t msg.command
  | `nosuchnick n -> err_nosuchnick t n
  | `notexttosend -> err_notexttosend t
  | `notregistered -> err_notregistered t
  | `unknowncommand -> err_unknowncommand t msg.command