iitalics
/
talircd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

yet another user register flow refactor

This commit is contained in:
tali 2024-01-10 22:49:07 -05:00
parent ae8b837c56
commit 7a101e0620
5 changed files with 102 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lib/irc/msg.ml
View File

@ -3,22 +3,13 @@ open Types
type prefix =
| No_prefix
| Server_prefix of string
| User_prefix of name * userinfo option * string option
let pp_userinfo_opt ppf = function
| None -> ()
| Some { username; _ } -> Format.fprintf ppf "!%s" username
let pp_hostname_opt ppf = function
| None -> ()
| Some hostname -> Format.fprintf ppf "@%s" hostname
| User_prefix of name * userinfo option
let prefix_string = function
| No_prefix -> ""
| Server_prefix s -> s
| User_prefix (nick, uinfo, host) ->
Format.asprintf "%s%a%a"
nick pp_userinfo_opt uinfo pp_hostname_opt host
| Server_prefix servername -> servername
| User_prefix (nick, None) -> nick
| User_prefix (nick, Some uinfo) -> Format.asprintf "%s%a" nick pp_userinfo uinfo
let pp_prefix ppf p =
Format.fprintf ppf "%S" (prefix_string p)
@ -158,14 +149,15 @@ let%expect_test _ =
Format.printf "%a" pp_prefix (Server_prefix "localhost");
[%expect {| "localhost" |}];
Format.printf "%a" pp_prefix (User_prefix ("tali", None, None));
Format.printf "%a" pp_prefix (User_prefix ("tali", None));
[%expect {| "tali" |}];
Format.printf "%a" pp_prefix (User_prefix ("tali", None, Some "elsewhere"));
[%expect {| "tali@elsewhere" |}];
let milo = { username = "milo"; realname = "Milo" } in
Format.printf "%a" pp_prefix (User_prefix ("tali", Some milo, Some "elsewhere"));
let milo = {
username = "milo";
realname = "Milo";
hostname = "elsewhere";
} in
Format.printf "%a" pp_prefix (User_prefix ("tali", Some milo));
[%expect {| "tali!milo@elsewhere" |}];
make "NICK" ["tali"] |> print_msg_nl;
@ -205,4 +197,4 @@ let%expect_test _ =
{ prefix = ""; command = "FOO"; params = []; trailing = false }
""
|}];

2
lib/irc/msg.mli
View File

@ -3,7 +3,7 @@ open Types
type prefix =
| No_prefix
| Server_prefix of string
| User_prefix of name * userinfo option * string option
| User_prefix of name * userinfo option
val prefix_string : prefix -> string

11
lib/irc/types.ml
View File

@ -1,5 +1,14 @@
type name = string
type userinfo = { username : string; realname : string }
type userinfo = {
username : string;
realname : string;
hostname : string;
}
let pp_userinfo ppf { username; realname; hostname } =
ignore realname;
Format.fprintf ppf "!%s@%s" username hostname
let name_type s =
let rec valid i =

141
lib/server/connection.ml
View File

@ -3,91 +3,89 @@ module User = Router.User
module Chan = Router.Chan
type t = {
addr : sockaddr;
router : Router.t;
user : User.t;
addr : sockaddr;
outbox : Outbox.t;
mutable user : User.t option;
mutable pending_nick : string option;
mutable pending_userinfo : Irc.userinfo option;
}
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 outbox = Outbox.make () in
let user = User.make ~hostname ~outbox in
{ addr; router; user; outbox; pending_nick = None }
{ router; addr; outbox; user = None; pending_nick = None; pending_userinfo = None }
let outbox t = t.outbox
let shutdown ?reason t =
if User.is_registered t.user then begin
(* TODO: relay to everyone interested *)
let reason = Option.value reason ~default:"Goot bye" in
Router.relay (Irc.Msg.make "QUIT" [reason])
~from:t.user (`to_interested t.user);
User.part_all t.user;
User.unregister t.user ~router:t.router;
end;
Option.iter
(fun me ->
let reason = Option.value reason ~default:"Goot bye" in
Router.relay (Irc.Msg.make "QUIT" [reason]) ~from:me (`to_interested me);
User.part_all me;
User.unregister me ~router:t.router)
t.user;
Outbox.close t.outbox
(* message handling *)
let require_registered t f =
if User.is_registered t.user then
f (Option.get t.user.userinfo)
else
`notregistered
(* > user registration *)
let require_registered t f =
match t.user with
| Some me -> f me
| None -> `notregistered
let attempt_to_register t =
match t.pending_nick, t.user.userinfo with
| Some nick, Some _userinfo ->
match t.pending_nick, t.pending_userinfo with
| Some nick, Some userinfo ->
t.pending_nick <- None;
begin match User.set_nick t.user nick ~router:t.router with
let me = User.make ~userinfo ~outbox:t.outbox in
begin match User.set_nick me nick ~router:t.router with
| `nick_in_use -> `nicknameinuse nick
| `nick_set ->
t.user <- Some me;
(* TODO: this sucks, fix it *)
let mode_msg = Irc.Msg.make "MODE" [nick; "+iw"] in
defer (fun () -> Router.relay mode_msg ~from:t.user `to_self);
defer (fun () -> Router.relay mode_msg ~from:me `to_self);
`welcome
`welcome me
end
| _, _ -> `ok
let on_msg_nick t nick =
if Irc.name_type nick <> `nick then
(if nick = "" then `nonicknamegiven else `erroneusnickname nick)
else if User.is_registered t.user then
let success_callback () =
let msg = Irc.Msg.make "NICK" [nick] in
Router.relay msg ~from:t.user (`to_interested t.user);
in
match User.set_nick t.user nick ~router:t.router ~success_callback with
| `nick_in_use -> `nicknameinuse nick
| `nick_set -> `ok
else begin
t.pending_nick <- Some nick;
attempt_to_register t
end
else match t.user with
| Some me ->
begin
let msg = Irc.Msg.make "NICK" [nick] in
match
User.set_nick me nick
~router:t.router
~success_callback:(fun () -> Router.relay msg ~from:me (`to_interested me))
with
| `nick_in_use -> `nicknameinuse nick
| `nick_set -> `ok
end
| None ->
t.pending_nick <- Some nick;
attempt_to_register t
let on_msg_user t username modestr realname =
if 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 };
let on_msg_user t username realname =
match t.user with
| Some _me -> `alreadyregistered
| None ->
(* TODO: configure hiding hostnames *)
let hostname = match t.addr with
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
| ADDR_UNIX path -> path
in
t.pending_userinfo <- Some { username; realname; hostname };
attempt_to_register t
end
(* > messages and channels *)
let on_msg_privmsg t tgt txt _ =
let on_msg_privmsg t tgt txt me =
(* TODO: comma-separated list of targets *)
let msg = Irc.Msg.make "PRIVMSG" [tgt; txt] ~always_trailing:true in
let dst =
@ -105,7 +103,7 @@ let on_msg_privmsg t tgt txt _ =
(* TODO: check if channel is +n and user is not a member *)
(* TODO: check if channel is +m and user is not priviledged *)
(* TODO: check if channel is +b <user> *)
Router.relay msg ~from:t.user dst;
Router.relay msg ~from:me dst;
`ok
let list_names chan =
@ -116,7 +114,7 @@ let list_names chan =
in
`names ("@", Chan.name chan, names)
let on_msg_names t name _ =
let on_msg_names t name _me =
(* TODO: comma-separated list of channels *)
match Irc.name_type name with
| `nick | `invalid ->
@ -131,7 +129,7 @@ let on_msg_names t name _ =
| None -> `nosuchchannel name
| Some chan -> list_names chan
let on_msg_join t name _ =
let on_msg_join t name me =
(* TODO: comma-separated list of channels *)
(* TODO: "0" parameter means part from all channels *)
match Irc.name_type name with
@ -146,18 +144,18 @@ let on_msg_join t name _ =
Chan.register chan ~router:t.router;
chan
in
if Chan.is_member chan t.user then
if Chan.is_member chan me then
`ok
else begin
(* TODO: check if channel is +k, get associated key from parameters *)
Chan.join chan t.user;
Chan.join chan me;
let msg = Irc.Msg.make "JOIN" [name] in
Router.relay msg ~from:t.user `to_self;
Router.relay msg ~from:t.user (`to_chan chan);
Router.relay msg ~from:me `to_self;
Router.relay msg ~from:me (`to_chan chan);
list_names chan
end
let on_msg_part t name _ =
let on_msg_part t name me =
(* TODO: comma-separated list of channels *)
(* TODO: part reason *)
match Irc.name_type name with
@ -171,12 +169,12 @@ let on_msg_part t name _ =
match chan with
| None -> `nosuchchannel name
| Some chan ->
if not (Chan.is_member chan t.user) then `notonchannel name
if not (Chan.is_member chan me) then `notonchannel name
else begin
let msg = Irc.Msg.make "PART" [name] in
Router.relay msg ~from:t.user `to_self;
Router.relay msg ~from:t.user (`to_chan chan);
Chan.part chan t.user;
Router.relay msg ~from:me `to_self;
Router.relay msg ~from:me (`to_chan chan);
Chan.part chan me;
if Chan.no_members chan then
Chan.unregister chan ~router:t.router;
`ok
@ -186,7 +184,7 @@ let on_msg_privmsg t tgt msg = require_registered t (on_msg_privmsg t tgt msg)
let on_msg_names t name = require_registered t (on_msg_names t name)
let on_msg_join t name = require_registered t (on_msg_join t name)
let on_msg_part t name = require_registered t (on_msg_part t name)
(* > misc *)
let on_msg_quit t reason =
@ -211,13 +209,15 @@ let srv_motd_lines = [
let rpl t cmd params =
let prefix = Irc.Msg.Server_prefix srv_host in
let target = User.nick t.user in
let target = match t.user with
| Some me -> User.nick me
| None -> "*"
in
Outbox.send t.outbox (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 (User.prefix t.user) in
let rpl_welcome t me =
let isupport = [
"CASEMAPPING=ascii";
"CHANTYPES=#";
@ -225,7 +225,8 @@ let rpl_welcome t =
"PREFIX=(ov)@+";
] in
begin
rpl t "001" [Fmt.str "Welcome to the tali IRC network %s" who];
rpl t "001" ["Welcome to the tali IRC network %s"
^ Irc.Msg.prefix_string (User.prefix me)];
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; "iow"; "imnst"; "bklov"];
@ -266,7 +267,7 @@ let on_msg t (msg : Irc.Msg.t) : unit =
match msg.command, msg.params with
| "NICK", new_nick :: _ -> on_msg_nick t new_nick
| "NICK", [] -> `nonicknamegiven
| "USER", u :: m :: _h :: r :: _ -> on_msg_user t u m r
| "USER", unm :: _ :: _ :: rnm :: _ -> on_msg_user t unm rnm
| "USER", _ -> `needmoreparams
| "QUIT", why -> on_msg_quit t why
| "MOTD", _ -> `motd
@ -282,7 +283,7 @@ let on_msg t (msg : Irc.Msg.t) : unit =
in
match result with
| `ok -> ()
| `welcome -> rpl_welcome t; rpl_motd t
| `welcome usr -> rpl_welcome t usr; rpl_motd t
| `motd -> rpl_motd t
| `names (cp, ch, us) -> rpl_names t cp ch us
| `tryagain -> rpl_tryagain t msg.command

18
lib/server/router.ml
View File

@ -7,10 +7,9 @@ type t = {
and user = {
outbox : Outbox.t;
hostname : string;
userinfo : Irc.userinfo;
mutable nick : Irc.name;
mutable nick_key : string_ci;
mutable userinfo : Irc.userinfo option;
mutable membership : membership Dllist.t;
}
@ -40,11 +39,11 @@ let find_user t nick =
let find_chan t name =
Hashtbl.find t.channels (string_ci name)
let user_prefix u =
Irc.Msg.User_prefix (u.nick, u.userinfo, Some u.hostname)
let user_prefix user =
Irc.Msg.User_prefix (user.nick, Some user.userinfo)
let relay ~from msg target =
let msg = { msg with Irc.Msg.prefix = user_prefix from } in
let relay ~(from : user) (msg : Irc.Msg.t) target =
let msg = { msg with prefix = user_prefix from } in
match target with
| `to_self ->
Outbox.send from.outbox msg
@ -68,13 +67,12 @@ let relay ~from msg target =
module User = struct
type t = user
let make ~hostname ~outbox =
let make ~userinfo ~outbox =
{
hostname;
outbox;
userinfo;
nick = "*";
nick_key = empty_string_ci;
userinfo = None;
(* mode = "+iw"; *)
membership = Dllist.create ();
}
@ -82,7 +80,7 @@ module User = struct
let outbox t = t.outbox
let nick t = t.nick
let prefix = user_prefix
let is_registered t = t.nick_key <> empty_string_ci
(* let is_registered t = t.nick_key <> empty_string_ci *)
let unregister t ~router =
Hashtbl.remove router.users t.nick_key;