Compare commits
5 Commits
81918b9813
...
d936d36a6a
Author | SHA1 | Date |
---|---|---|
tali | d936d36a6a | |
tali | cf11a13945 | |
tali | 454d27780c | |
tali | 00eae82eb3 | |
tali | a34651b283 |
|
@ -0,0 +1,3 @@
|
||||||
|
IRC_MOTD=/etc/talircd.motd
|
||||||
|
IRC_HOSTNAME=irc.tali.software
|
||||||
|
IRC_PORT=6667
|
|
@ -6,17 +6,16 @@ eval $(opam env)
|
||||||
|
|
||||||
root=dist/root
|
root=dist/root
|
||||||
rm -rf $root
|
rm -rf $root
|
||||||
mkdir -p $root/DEBIAN $root/etc $root/usr/lib/systemd/system
|
mkdir -p $root/usr/lib/systemd/system $root/DEBIAN
|
||||||
|
|
||||||
# build ocaml program
|
# build ocaml program
|
||||||
|
|
||||||
opam pin add ./talircd --kind=path --no-action --yes
|
opam pin add ./talircd --kind=path --no-action --yes
|
||||||
opam install talircd --destdir=$root/usr --yes
|
opam install talircd --destdir=$root/usr --yes
|
||||||
|
|
||||||
# install helper files
|
# install service file
|
||||||
|
|
||||||
install -m 644 talircd/deploy/talircd.service $root/usr/lib/systemd/system
|
install -m 644 talircd/deploy/talircd.service $root/usr/lib/systemd/system
|
||||||
install -m 644 talircd/deploy/talircd.conf $root/etc
|
|
||||||
|
|
||||||
# generate package control file
|
# generate package control file
|
||||||
|
|
||||||
|
@ -37,6 +36,8 @@ echo "Description: ${dsc}" >> $control
|
||||||
echo "Maintainer: ${mtr}" >> $control
|
echo "Maintainer: ${mtr}" >> $control
|
||||||
echo "Architecture: ${arch}" >> $control
|
echo "Architecture: ${arch}" >> $control
|
||||||
|
|
||||||
|
install -m 755 talircd/deploy/postinst.sh $root/DEBIAN/postinst
|
||||||
|
|
||||||
# generate .deb
|
# generate .deb
|
||||||
|
|
||||||
dpkg-deb --root-owner-group -b $root "dist/${pkg}_${ver}-${rev}_${arch}.deb"
|
dpkg-deb --root-owner-group -b $root "dist/${pkg}_${ver}-${rev}_${arch}.deb"
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
#!/usr/bin/sh
|
||||||
|
[ -f /etc/talircd.conf ] || install -m 644 /usr/share/talircd/default/conf /etc/talircd.conf
|
||||||
|
[ -f /etc/talircd.motd ] || install -m 644 /usr/share/talircd/default/motd /etc/talircd.motd
|
||||||
|
systemctl daemon-reload
|
|
@ -1,4 +0,0 @@
|
||||||
IRC_MOTD=/usr/share/talircd/motd
|
|
||||||
IRC_HOSTNAME=irc.tali.software
|
|
||||||
IRC_PORT=6667
|
|
||||||
LOG_LEVEL=debug
|
|
4
dune
4
dune
|
@ -1,4 +1,6 @@
|
||||||
(install
|
(install
|
||||||
(package talircd)
|
(package talircd)
|
||||||
(files (motd.txt as motd))
|
(files
|
||||||
|
(motd.txt as default/motd)
|
||||||
|
(conf.txt as default/conf))
|
||||||
(section share))
|
(section share))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(lang dune 3.8)
|
(lang dune 3.8)
|
||||||
(name talircd)
|
(name talircd)
|
||||||
(version 0.0.2)
|
(version 0.0.3)
|
||||||
|
|
||||||
(generate_opam_files true)
|
(generate_opam_files true)
|
||||||
|
|
||||||
|
|
|
@ -24,6 +24,7 @@ let creation_time t = t.creation_time
|
||||||
let topic t = fst t.topic
|
let topic t = fst t.topic
|
||||||
let topic_who_time t = snd t.topic
|
let topic_who_time t = snd t.topic
|
||||||
let set_topic ~who ?time t text = t.topic <- text, Some (who, value_or_now time)
|
let set_topic ~who ?time t text = t.topic <- text, Some (who, value_or_now time)
|
||||||
|
let member_count t = t.member_count
|
||||||
let mode t = t.chan_mode
|
let mode t = t.chan_mode
|
||||||
let set_mode t new_mode = t.chan_mode <- new_mode
|
let set_mode t new_mode = t.chan_mode <- new_mode
|
||||||
let limit t = t.chan_limit
|
let limit t = t.chan_limit
|
||||||
|
|
|
@ -280,22 +280,22 @@ let on_msg_mode t name args =
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
||||||
|
|
||||||
(* messages and channels *)
|
(* messages *)
|
||||||
|
|
||||||
|
let get_priv_opt chan user =
|
||||||
|
try
|
||||||
|
let mem = Router.membership chan user in
|
||||||
|
Some mem.mem_priv
|
||||||
|
with Not_found ->
|
||||||
|
None
|
||||||
|
|
||||||
let send_to_chan ~from chan =
|
let send_to_chan ~from chan =
|
||||||
let cannot_send =
|
let priv_required =
|
||||||
try
|
if Mode.Set.mem `m (Chan.mode chan) then Some Voice
|
||||||
let mem = Router.membership chan from in
|
else if Mode.Set.mem `n (Chan.mode chan) then Some Normal
|
||||||
(* check if moderated (+m) *)
|
else None
|
||||||
if Mode.Set.mem `m (Chan.mode chan) then
|
|
||||||
mem.mem_priv < Voice
|
|
||||||
else
|
|
||||||
false
|
|
||||||
with Not_found ->
|
|
||||||
(* check if no external messages (+n) *)
|
|
||||||
Mode.Set.mem `n (Chan.mode chan)
|
|
||||||
in
|
in
|
||||||
if cannot_send then
|
if get_priv_opt chan from < priv_required then
|
||||||
Error (cannotsendtochan (Chan.name chan))
|
Error (cannotsendtochan (Chan.name chan))
|
||||||
else
|
else
|
||||||
Ok (Chan.name chan, [`to_chan chan])
|
Ok (Chan.name chan, [`to_chan chan])
|
||||||
|
@ -336,6 +336,9 @@ let on_msg_away t status =
|
||||||
set_away t me status;
|
set_away t me status;
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
||||||
|
|
||||||
|
(* channels *)
|
||||||
|
|
||||||
let membership_prefix = function
|
let membership_prefix = function
|
||||||
| Normal -> ""
|
| Normal -> ""
|
||||||
| Voice -> "+"
|
| Voice -> "+"
|
||||||
|
@ -344,30 +347,29 @@ let membership_prefix = function
|
||||||
let is_invisible user =
|
let is_invisible user =
|
||||||
Mode.Set.mem `i (User.mode user)
|
Mode.Set.mem `i (User.mode user)
|
||||||
|
|
||||||
let list_names t me chan =
|
let is_secret chan =
|
||||||
let is_secret = Mode.Set.mem `s (Chan.mode chan) in
|
Mode.Set.mem `s (Chan.mode chan)
|
||||||
|
|
||||||
|
let list_names t me chan =
|
||||||
let members =
|
let members =
|
||||||
match Router.membership chan me with
|
match Router.membership chan me with
|
||||||
| _is_member -> Chan.membership chan
|
| _is_member -> Chan.membership chan
|
||||||
| exception Not_found ->
|
| exception Not_found ->
|
||||||
if is_secret then
|
if is_secret chan then
|
||||||
[]
|
[]
|
||||||
else
|
else
|
||||||
Chan.membership_when
|
Chan.membership_when
|
||||||
(fun mem -> not (is_invisible mem.mem_user))
|
(fun mem -> not (is_invisible mem.mem_user))
|
||||||
chan
|
chan
|
||||||
in
|
in
|
||||||
|
|
||||||
let nicks =
|
let nicks =
|
||||||
List.map
|
List.map
|
||||||
(fun mem ->
|
(fun mem ->
|
||||||
membership_prefix mem.mem_priv ^ User.nick mem.mem_user)
|
membership_prefix mem.mem_priv ^ User.nick mem.mem_user)
|
||||||
members
|
members
|
||||||
in
|
in
|
||||||
|
|
||||||
let chan_name = Chan.name chan in
|
let chan_name = Chan.name chan in
|
||||||
let chan_sym = if is_secret then "@" else "=" in
|
let chan_sym = if is_secret chan then "@" else "=" in
|
||||||
begin
|
begin
|
||||||
(* TODO: concat member names until message becomes too long *)
|
(* TODO: concat member names until message becomes too long *)
|
||||||
List.iter (fun nick -> reply t ("353", [chan_sym; chan_name; nick])) nicks;
|
List.iter (fun nick -> reply t ("353", [chan_sym; chan_name; nick])) nicks;
|
||||||
|
@ -683,6 +685,43 @@ let on_msg_userhost t nicks =
|
||||||
reply t ("302", [String.concat " " results]);
|
reply t ("302", [String.concat " " results]);
|
||||||
Ok ()
|
Ok ()
|
||||||
|
|
||||||
|
let list_channels t me channels =
|
||||||
|
begin
|
||||||
|
reply t ("321", ["Channel"; "Users Name"]);
|
||||||
|
Seq.iter
|
||||||
|
(function
|
||||||
|
| Error err -> reply t err
|
||||||
|
| Ok chan ->
|
||||||
|
try
|
||||||
|
if is_secret chan then Router.membership chan me |> ignore;
|
||||||
|
let count = Chan.member_count chan in
|
||||||
|
let topic = Option.value (Chan.topic chan) ~default:"" in
|
||||||
|
reply t ("322", [Chan.name chan; string_of_int count; topic])
|
||||||
|
with Not_found ->
|
||||||
|
())
|
||||||
|
channels;
|
||||||
|
reply t ("323", ["End of /LIST"]);
|
||||||
|
end
|
||||||
|
|
||||||
|
let on_msg_list t names =
|
||||||
|
let* me = require_registered t in
|
||||||
|
let channels = match names with
|
||||||
|
| [] ->
|
||||||
|
Seq.map Result.ok
|
||||||
|
(Router.all_channels_seq t.router)
|
||||||
|
| _ ->
|
||||||
|
Seq.map
|
||||||
|
(fun name ->
|
||||||
|
try
|
||||||
|
match name_type name with
|
||||||
|
| `chan -> Ok (Router.find_chan t.router name)
|
||||||
|
| `nick | `invalid -> raise Not_found
|
||||||
|
with Not_found ->
|
||||||
|
Error (nosuchnick name))
|
||||||
|
(List.to_seq names)
|
||||||
|
in
|
||||||
|
list_channels t me channels;
|
||||||
|
Ok ()
|
||||||
|
|
||||||
(* welcome and quit *)
|
(* welcome and quit *)
|
||||||
|
|
||||||
|
@ -935,6 +974,8 @@ let dispatch t = function
|
||||||
| "WHOWAS", ([] | "" :: _) -> Error nonicknamegiven
|
| "WHOWAS", ([] | "" :: _) -> Error nonicknamegiven
|
||||||
| "WHOWAS", [nick] -> on_msg_whowas t nick ""
|
| "WHOWAS", [nick] -> on_msg_whowas t nick ""
|
||||||
| "WHOWAS", nick :: count :: _ -> on_msg_whowas t nick count
|
| "WHOWAS", nick :: count :: _ -> on_msg_whowas t nick count
|
||||||
|
| "LIST", chans :: _ -> on_msg_list t (String.split_on_char ',' chans)
|
||||||
|
| "LIST", [] -> on_msg_list t []
|
||||||
| "USERHOST", nicks -> on_msg_userhost t nicks
|
| "USERHOST", nicks -> on_msg_userhost t nicks
|
||||||
| ("USER" | "JOIN" | "NAMES" | "PART" | "KICK" | "MODE" | "WHO") as cmd, _ ->
|
| ("USER" | "JOIN" | "NAMES" | "PART" | "KICK" | "MODE" | "WHO") as cmd, _ ->
|
||||||
Error (needmoreparams cmd)
|
Error (needmoreparams cmd)
|
||||||
|
@ -948,7 +989,6 @@ let dispatch t = function
|
||||||
| tgt :: msg :: _ -> on_msg_privmsg t tgt msg ~cmd
|
| tgt :: msg :: _ -> on_msg_privmsg t tgt msg ~cmd
|
||||||
end
|
end
|
||||||
|
|
||||||
(* TODO: "LIST" *)
|
|
||||||
| cmd, _ ->
|
| cmd, _ ->
|
||||||
Error (unknowncommand cmd)
|
Error (unknowncommand cmd)
|
||||||
|
|
||||||
|
|
|
@ -28,6 +28,9 @@ let find_chan t name =
|
||||||
let whowas t nick =
|
let whowas t nick =
|
||||||
Cache.find_all t.whowas (string_ci nick)
|
Cache.find_all t.whowas (string_ci nick)
|
||||||
|
|
||||||
|
let all_channels_seq t =
|
||||||
|
Hashtbl.to_seq_values t.channels
|
||||||
|
|
||||||
let nuke t =
|
let nuke t =
|
||||||
begin
|
begin
|
||||||
Hashtbl.iter (fun _ u -> Dllist.reset u.membership) t.users;
|
Hashtbl.iter (fun _ u -> Dllist.reset u.membership) t.users;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
# This file is generated by dune, edit dune-project instead
|
# This file is generated by dune, edit dune-project instead
|
||||||
opam-version: "2.0"
|
opam-version: "2.0"
|
||||||
version: "0.0.2"
|
version: "0.0.3"
|
||||||
synopsis: "IRC server"
|
synopsis: "IRC server"
|
||||||
description: "IRC server for cats written in ocaml"
|
description: "IRC server for cats written in ocaml"
|
||||||
maintainer: ["iitalics <git.lain.faith/iitalics>"]
|
maintainer: ["iitalics <git.lain.faith/iitalics>"]
|
||||||
|
|
Loading…
Reference in New Issue