--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null
+(* -*- mode: tuareg -*- ******************************************************)
+(* *)
+(* This is a light IRC client written in CAML *)
+(* Written by and (c) Francois Fleuret, 2002 - 2005 *)
+(* Contact <francois.fleuret@epfl.ch> for info and bug reports *)
+(* *)
+(* This program is free software; you can redistribute it and/or modify *)
+(* it under the terms of the GNU General Public License Version 2 as *)
+(* published by the Free Software Foundation. See the file LICENSE for *)
+(* more details. *)
+(* *)
+(*****************************************************************************)
+
+open Connection;;
+
+(* I removed all the dcc stuff between v0.25 and v0.5 because it was a
+ biiiig pile of crap. Feel free to write it ! *)
+
+let version = "IRCML v0.5";;
+
+let term_bold = ref "\e[1m"
+and term_underline = ref "\e[4m"
+and term_inverse = ref "\e[7m"
+and term_reset = ref "\e[m";;
+
+(*****************************************************************************)
+(* Various stuff *)
+(*****************************************************************************)
+
+let keys h = Hashtbl.fold (fun key data accu -> key :: accu) h []
+
+let verbose = ref false;;
+
+(* Return the element after the given one, or the first of the list if
+ the given one is the last *)
+
+let circular_succ =
+ fun x l ->
+ let rec next_rec x = function
+ [] -> raise Not_found
+ | h::t -> if h = x then List.hd t else next_rec x t
+ in try next_rec x l with Failure(e) -> List.hd l;;
+
+let string_of_size size =
+ if size > 1048576 then (string_of_int (size / 1048576))^"Mb"
+ else if size > 1024 then (string_of_int (size / 1024))^"Kb"
+ else (string_of_int size) ^ "b";;
+
+let duration_of_seconds duration =
+ (if duration >= 3600 then (string_of_int (duration/3600))^"h" else "") ^
+ (if (duration mod 3600) >= 60 then (string_of_int ((duration mod 3600)/60))^"min" else "") ^
+ (if (duration mod 60) > 0 then (string_of_int (duration mod 60))^"s" else "");;
+
+(*****************************************************************************)
+(* The global variables *)
+(*****************************************************************************)
+
+type user_status = { mutable operator: bool }
+let string_of_user = fun u -> (if u.operator then "@" else "")
+
+type channel = { name: string; people: (string, user_status) Hashtbl.t ; modes: (char, string) Hashtbl.t };;
+
+let ssfe = ref false
+
+and my_host = ref ""
+
+and desired_nick = ref "b0z0"
+and desired_server = ref "localhost"
+and desired_port = ref 6667
+
+and current_nick = ref ""
+and (current_modes: (char, string) Hashtbl.t) = Hashtbl.create 10
+and default_channel = ref ""
+
+and login = ref "c4mlp0w4"
+and name = ref ("Using " ^ version ^ ", the light IRC client in CAML")
+
+and alive = ref true;;
+
+(* Print something with a 'header character' à la sirc *)
+(* '<' Leaving channel (part, kick, signoff, etc.) *)
+(* '>' Joining a channel *)
+(* 'E' Error *)
+(* 'I' Information *)
+(* 'X' Internal error, should never meet one *)
+let printh h s = output_string Pervasives.stdout
+ begin
+ match h with
+ "E" -> (!term_bold ^ "*" ^ h ^ "*" ^ " " ^ s ^ !term_reset ^ "\n")
+ | _ -> (!term_bold ^ "*" ^ h ^ "*" ^ !term_reset ^ " " ^ s ^ "\n")
+ end;;
+
+(* Simply print something in the console *)
+let print s = output_string Pervasives.stdout (s ^ "\n");;
+
+type ssfe_cmd = Status of string | Tabulable of string;;
+
+let current_status = ref "";;
+
+let tell_ssfe x =
+ if !ssfe then begin
+ match x with
+ Status(s) -> if not (s = !current_status) then (current_status := s; print ("`#ssfe#s" ^ s))
+ | Tabulable(s) -> print ("`#ssfe#t" ^ s)
+ end;;
+
+(*****************************************************************************)
+(* Command line parameter parsing *)
+(*****************************************************************************)
+
+Arg.parse [ ("-nick", Arg.String(fun n -> desired_nick := n), "Set the desired nick");
+ ("-server", Arg.String(fun s -> desired_server := s), "Set the desired server");
+ ("-port", Arg.Int(fun p -> desired_port := p), "Set the desired port");
+ ("-login", Arg.String(fun s -> login := s), "Set the login");
+ ("-name", Arg.String(fun s -> name := s), "Set the name") ]
+ (fun s -> ()) "Unknown option";;
+
+(*****************************************************************************)
+(* The connection with the server *)
+(*****************************************************************************)
+
+type connection =
+ Established of Unix.file_descr
+ | Broken;;
+
+let last_server_msg = ref 0;;
+
+let server_connection = ref Broken;;
+
+(* This is the list of file descriptors active for reading. Each one
+ corresponds to a reader which will be called when something is
+ readable and a exception-handler, called if the connection is lost,
+ with the reason *)
+
+type fd_machine = { reader: unit -> unit; error_handler: string -> unit };;
+
+let (fd_active: (Unix.file_descr, fd_machine) Hashtbl.t) = Hashtbl.create 10;;
+
+(*****************************************************************************)
+(* Handling of the channel list *)
+(*****************************************************************************)
+
+let (joined_channels: (string, channel) Hashtbl.t) = Hashtbl.create 10;;
+
+let find_joined c = Hashtbl.find joined_channels (String.uppercase c)
+and mem_joined c = Hashtbl.mem joined_channels (String.uppercase c)
+and set_joined c x = Hashtbl.replace joined_channels (String.uppercase c) x
+and remove_joined c = Hashtbl.remove joined_channels (String.uppercase c)
+and same_channel c1 c2 = (String.uppercase c1) = (String.uppercase c2);;
+
+let part_channel channel =
+ remove_joined channel;
+ if !default_channel = channel
+ then match (keys joined_channels) with
+ [] -> default_channel := ""; if not !ssfe then printh "I" "Not in a channel anymore"
+ | c::t -> default_channel := c; printh "I" ("Talking to " ^ !default_channel ^ " now");;
+
+(*****************************************************************************)
+(* Takes a string and returns an array of strings corresponding to the *)
+(* tokens in the IRC protocole syntax. I.e. tokens are separated by white *)
+(* spaces except the tail which is after a ':' *)
+(*****************************************************************************)
+
+let (irc_tokenize: string -> string array) = fun s ->
+ let l = (String.length s) in
+ let rec irc_tokenize s n =
+ if String.get s n == ':' then [String.sub s (n + 1) (l - n - 2)] else
+ try
+ let m = String.index_from s n ' ' in
+ let h = String.sub s n (m - n) in
+ h::irc_tokenize s (m+1)
+ with
+ Not_found -> if n < l then [String.sub s n (l - n - 1)] else []
+ in
+ (* Ignore the prefix if there is one *)
+ if (String.get s 0) == ':' then
+ let n = (String.index s ' ') in Array.of_list ((String.sub s 1 (n - 1))::(irc_tokenize s (n+1)))
+ else Array.of_list (""::(irc_tokenize s 0));;
+
+(* Function to split the "nick!login@host" *)
+
+let (split_prefix: string -> string * string * string) = fun prefix ->
+ let n1 = (String.index prefix '!') in
+ let n2 = (String.index_from prefix n1 '@') in
+ (String.sub prefix 0 n1,
+ String.sub prefix (n1 + 1) (n2 - (n1 + 1)),
+ String.sub prefix (n2 + 1) ((String.length prefix) - (n2 + 1)));;
+
+(*****************************************************************************)
+(* The aliases *)
+(*****************************************************************************)
+
+let (cmd_aliases: (string, string) Hashtbl.t) = Hashtbl.create 100;;
+
+List.iter (fun (a, b) -> Hashtbl.replace cmd_aliases a b) [
+ ("J", "JOIN"); ("M", "MSG"); ("K", "KICK"); ("L", "CHANINFO");
+ ("N", "NICK"); ("Q", "QUIT"); ("T", "TOPIC"); ("W", "WHOIS");
+ ("DC", "DISCONNECT"); ("S", "SERVER"); ("H", "HELP")
+];;
+
+(*****************************************************************************)
+(* The managers will be filled later *)
+(*****************************************************************************)
+
+let (protocole_managers: (string, string array -> unit) Hashtbl.t) = Hashtbl.create 100;;
+let (cmd_managers: (string, string * ((unit -> string) -> (unit -> string) -> unit)) Hashtbl.t) = Hashtbl.create 100;;
+let (ctcp_managers: (string, (unit -> string) -> (unit -> string) -> string -> string -> unit) Hashtbl.t) = Hashtbl.create 10;;
+
+(*****************************************************************************)
+(* The routines handling lines from the server or the user *)
+(*****************************************************************************)
+
+let print_unknown_protocole = fun tokens ->
+ let buffer = Buffer.create 100 in
+ Buffer.add_string buffer "Unknown protocole";
+ for i = 0 to ((Array.length tokens) - 1) do
+ Buffer.add_string buffer (" " ^ (string_of_int i) ^ ":(" ^ tokens.(i) ^ ")");
+ done;
+ printh "X" (Buffer.contents buffer);;
+
+let server_line_handler = fun line ->
+ if !verbose then (print_string ("SERVER [" ^ line ^ "]\n"); flush stdout);
+ last_server_msg := int_of_float (Unix.time ());
+ let tokens = (irc_tokenize line) in
+ try
+ let f = Hashtbl.find protocole_managers tokens.(1) in
+ try f tokens with Not_found -> printh "E" ("Protocole " ^ tokens.(1) ^ " raised Not_found!")
+ with
+ Not_found -> print_unknown_protocole tokens;;
+
+let kill_server_connection error_message =
+ match !server_connection with
+ Established(fd) ->
+ begin
+ Hashtbl.remove fd_active fd;
+ server_connection := Broken;
+ printh "E" ("Connection lost (" ^ error_message ^ ")");
+ default_channel := "";
+ Hashtbl.clear joined_channels
+ end
+ | Broken -> exit 1;;
+
+let tell_server line =
+ match !server_connection with
+ Established(fd) ->
+ begin
+ try
+ if (Unix.write fd line 0 (String.length line)) <= 0 then kill_server_connection ("write error")
+ with
+ Unix.Unix_error(e, fname, fparam) -> kill_server_connection (fname ^ ": " ^ (Unix.error_message e))
+ end
+ | Broken -> printh "E" "No connection";;
+
+let establish_connection () =
+ match !server_connection with
+ Established(_) -> printh "E" "Connection already established (try /DISCONNECT first)"
+ | Broken ->
+ printh "I" ("Attempting connection to " ^ !desired_server ^
+ ":" ^ (string_of_int !desired_port) ^
+ " with nick " ^ !desired_nick);
+ try
+ let fd = Connection.connect !desired_server !desired_port in
+ begin
+ match Unix.getsockname fd with
+ Unix.ADDR_INET(ai, _) -> my_host := Connection.dot_to_number (Unix.string_of_inet_addr ai)
+ | _ -> printh "E" "Internal error #0";
+ end;
+ server_connection := Established(fd);
+ Hashtbl.replace fd_active fd { reader = linizer fd server_line_handler; error_handler = kill_server_connection };
+ tell_server ("USER " ^ !login ^ " caml rulez :" ^ !name ^ "\n");
+ tell_server ("NICK " ^ !desired_nick ^ "\n");
+ last_server_msg := int_of_float (Unix.time ());
+ printh "I" ("Connection established, waiting for server checkings.");
+ with
+ Network_error(e) -> printh "E" ("Can not connect to host: " ^ e);;
+
+let stdin_line_handler = fun line ->
+ (*print_string ("STDIN [" ^ line ^ "]\n"); flush stdout;*)
+ if String.length line > 0 then
+ match String.get line 0 with
+ '/' ->
+ begin
+ let (cl_token, cl_tail) = tokenizer line ' ' in
+ let cmd = String.uppercase (cl_token ()) in let cmd = String.sub cmd 1 ((String.length cmd) - 1) in
+ let cmd = try Hashtbl.find cmd_aliases cmd with Not_found -> cmd in
+ try
+ let (_, f) = (Hashtbl.find cmd_managers cmd) in
+ begin
+ try
+ f cl_token cl_tail
+ with
+ Not_found -> printh "E" ("Command " ^ cmd ^ " raised Not_found!")
+ end
+ with
+ Not_found -> printh "E" ("Unknown command '" ^ cmd ^ "'");
+ end
+
+ | '@' ->
+ begin
+ let (cl_token, cl_tail) = tokenizer line ' ' in
+ match cl_token () with
+ "@ssfe@i" ->
+ begin
+ ssfe := true;
+ printh "I" "You are using ssfe";
+ term_bold := "\ 2";
+ term_underline := "\1f";
+ term_inverse := "\16";
+ term_reset := "";
+ end
+ | _ -> ()
+ end
+
+ | _ ->
+ if !default_channel = ""
+ then printh "E" "Not in a channel"
+ else
+ begin
+ print ("<" ^ !current_nick ^ "> " ^ line);
+ tell_server ("PRIVMSG " ^ !default_channel ^ " :" ^ line ^ "\n")
+ end;;
+
+let console_reader = linizer Unix.stdin stdin_line_handler
+and console_error = fun error_message -> printh "E" ("Stdin error (" ^ error_message ^ ")"); exit 1 in
+ Hashtbl.replace fd_active Unix.stdin { reader = console_reader; error_handler = console_error };;
+
+(*****************************************************************************)
+(* Functions to handle scripts *)
+(*****************************************************************************)
+
+Hashtbl.add cmd_managers
+ "LOAD"
+ begin
+ "<module>: Loads the given bytecode object",
+ fun token tail ->
+ try
+ let module_name = token () in
+ printh "I" ("loading module " ^ module_name);
+ try
+ Dynlink.loadfile(module_name)
+ with
+ Dynlink.Error error -> printh "E" ("Module loading error (" ^ (Dynlink.error_message error) ^ ")");
+ | Sys_error error_message -> printh "E" ("Module loading error (" ^ error_message ^ ")");
+ with
+ Not_found -> printh "E" "Missing argument"
+ end;
+
+(*****************************************************************************)
+(* Functions to handle the various user commands *)
+(*****************************************************************************)
+
+(* Each manager gets two (unit -> string), the first one to get tokens
+ one after another and the second one to get the tail when required *)
+
+Hashtbl.add cmd_managers
+ "TEST"
+ begin
+ "",
+ fun token tail ->
+ Hashtbl.iter
+ begin
+ fun name chan ->
+ Hashtbl.iter
+ (fun nick user -> print ("on " ^ name ^ " : [" ^ (string_of_user user) ^ "] " ^ nick))
+ chan.people
+ end
+ joined_channels
+ end;
+
+Hashtbl.add cmd_managers
+ "HELP"
+ begin
+ "[<cmd>]: Shows the help for the given command, or for all of them",
+ fun token tail ->
+ try
+ let cmd = String.uppercase (token ()) in
+ try
+ let (h, f) = (Hashtbl.find cmd_managers cmd) in
+ printh "H" ("/" ^ cmd ^ " " ^ h)
+ with
+ Not_found -> printh "H" ("Unknown command " ^ cmd)
+ with
+ Not_found -> Hashtbl.iter (fun cmd (help, f) -> (printh "H" ("/" ^ cmd ^ " " ^ help))) cmd_managers
+ end;
+
+Hashtbl.add cmd_managers
+ "ME"
+ begin
+ "[<action description>]: Describes an action in the default channel",
+ fun token tail ->
+ if !default_channel = ""
+ then printh "E" "Not in a channel"
+ else let msg = try (tail ()) with Not_found -> "" in
+ tell_server ("PRIVMSG " ^ !default_channel ^ " :\ 1ACTION " ^ msg ^ "\ 1\n");
+ print ("* " ^ !current_nick ^ " " ^ msg)
+ end;
+
+Hashtbl.add cmd_managers
+ "AWAY"
+ begin
+ "[<message>]: Sets yourself away",
+ fun token tail ->
+ try tell_server ("AWAY :" ^ (tail ()) ^ "\n")
+ with Not_found -> tell_server "AWAY\n";
+ end;
+
+Hashtbl.add cmd_managers
+ "MSG"
+ begin
+ "<nick|#channel> <message>: Sends a message to a user, or a channel",
+ fun token tail ->
+ try
+ let dest = (token ()) and msg = (tail ()) in
+ tell_ssfe (Tabulable ("/msg " ^ dest ^ " "));
+ match String.get dest 0 with
+ '#' | '&' ->
+ begin
+ print ("<" ^ !current_nick ^ (if same_channel !default_channel dest then "" else "/" ^ dest) ^ "> " ^ msg);
+ tell_server ("PRIVMSG " ^ dest ^ " :" ^ msg ^ "\n")
+ end
+
+ | _ ->
+ begin
+ print (">" ^ dest ^ "< " ^ msg);
+ tell_server ("PRIVMSG " ^ dest ^ " :" ^ msg ^ "\n")
+ end
+
+ with Not_found -> printh "E" "Missing parameter"
+ end;
+
+Hashtbl.add cmd_managers
+ "CTCP"
+ begin
+ "<nick|#channel> <ctcp string>: Sends a CTCP (string quoted between ^A) to a user or a channel",
+ fun token tail ->
+ try
+ let dest = (token ()) and msg = (tail ()) in
+ tell_ssfe (Tabulable ("/msg " ^ dest ^ " "));
+ printh "I" ("Sending a CTCP " ^ msg ^ " to " ^ dest);
+ tell_server ("PRIVMSG " ^ dest ^ " :\ 1" ^ msg ^ "\ 1\n")
+ with Not_found -> printh "E" "Missing parameter"
+ end;
+
+Hashtbl.add cmd_managers
+ "NOTICE"
+ begin
+ "<nick|#channel> <message>: Sends a notice to a user or a channel",
+ fun token tail ->
+ try
+ let dest = (token ()) and msg = (tail ()) in
+ print ("-> -" ^ dest ^ "- " ^ msg); tell_server ("PRIVMSG " ^ dest ^ " :" ^ msg ^ "\n")
+ with Not_found -> printh "E" "Missing parameter"
+ end;
+
+Hashtbl.add cmd_managers
+ "WHOIS"
+ begin
+ "[<nick>]: Requests information about a user",
+ fun token tail ->
+ let nick = try token () with Not_found -> !current_nick in
+ if nick = ""
+ then printh "E" "Missing argument"
+ else tell_server ("WHOIS " ^ nick ^ "\n")
+ end;
+
+Hashtbl.add cmd_managers
+ "WI"
+ begin
+ "[<nick>]: Requests information about a user on his server (get the idle)",
+ fun token tail ->
+ let nick = try token () with Not_found -> !current_nick in
+ if nick = ""
+ then printh "E" "Missing argument"
+ else tell_server ("WHOIS " ^ nick ^ " " ^ nick ^ "\n")
+ end;
+
+Hashtbl.add cmd_managers
+ "SERVER"
+ begin
+ "[<server>[:<port>]]: Establishes a connection to a new server",
+ fun token tail ->
+ begin
+ try
+ let (stoken, stail) = tokenizer (token ()) ':' in
+ desired_server := stoken ();
+ desired_port := int_of_string (stoken ())
+ with
+ Not_found -> ()
+ | Failure(_) -> printh "E" "Syntax error"
+ end;
+ establish_connection ()
+ end;
+
+Hashtbl.add cmd_managers
+ "NEXT"
+ begin
+ ": Selects the next joined channel as default",
+ fun token tail ->
+ try
+ default_channel := (find_joined (circular_succ (String.uppercase !default_channel) (keys joined_channels))).name;
+ if not !ssfe then printh "I" ("Talking to " ^ !default_channel ^ " now")
+ with
+ Not_found -> printh "E" "You have to join a channel first"
+ end;
+
+Hashtbl.add cmd_managers
+ "JOIN"
+ begin
+ "[<#channel> [<key>]]: Joins a channel or tells what is the default channel",
+ fun token tail ->
+ try
+ let channel = token () in let chan = match String.get channel 0 with '#' | '&' -> channel | _ -> "#" ^ channel in
+ let key = try " " ^ (token ()) with Not_found -> "" in
+ if mem_joined channel
+ then (default_channel := chan; if not !ssfe then printh "I" ("Talking to " ^ chan ^ " now"))
+ else tell_server ("JOIN " ^ chan ^ key ^ "\n")
+ with Not_found ->
+ if !default_channel = ""
+ then printh "I" "You are not in a channel"
+ else printh "I" ("You current channel is " ^ !default_channel)
+ end;
+
+Hashtbl.add cmd_managers
+ "TOPIC"
+ begin
+ "[<topic>]: Sets or requests the topic in the current channel",
+ fun token tail ->
+ if !default_channel = ""
+ then printh "E" "Not in a channel"
+ else
+ try let topic = tail () in tell_server ("TOPIC " ^ !default_channel ^ " :" ^ topic ^ "\n")
+ with Not_found -> tell_server ("TOPIC " ^ !default_channel ^ "\n")
+ end;
+
+Hashtbl.add cmd_managers
+ "MODE"
+ begin
+ "[<mode change>]: Changes mode or shows the mode of the current channel",
+ fun token tail ->
+ let chan = try token () with Not_found -> !default_channel in
+ if chan = ""
+ then printh "E" "Need to specify a channel"
+ else
+ let chan = match String.get chan 0 with '#' | '&' -> chan | _ -> "#" ^ chan in
+ try tell_server ("MODE " ^ chan ^ " " ^ (tail ()) ^ "\n")
+ with Not_found -> tell_server ("MODE " ^ chan ^ "\n")
+ end;
+
+Hashtbl.add cmd_managers
+ "KICK"
+ begin
+ "[<#channel>] <nick> [<comment>]: Kicks the given user from the given (or current) channel",
+ fun token tail ->
+ if !default_channel = ""
+ then printh "E" "Not in a channel"
+ else try
+ let t = token () in
+ let (channel, nick) = match String.get t 0 with '#' | '&' -> (t, token ()) | _ -> (!default_channel, t)
+ and comment = try tail () with Not_found -> "B1G d0Rk5 SuCk M00z b4LLz" in
+ tell_server ("KICK " ^ !default_channel ^ " " ^ nick ^ " :" ^ comment ^ "\n")
+ with Not_found -> printh "E" "Missing parameter"
+ end;
+
+Hashtbl.add cmd_managers
+ "LEAVE"
+ begin
+ "[<#channel>]: Leaves the current or the specified channel",
+ fun token tail ->
+ let chan = try token () with Not_found -> !default_channel in
+ if chan = ""
+ then printh "E" "Need to specify a channel"
+ else let chan = match String.get chan 0 with '#' | '&' -> chan | _ -> "#" ^ chan in
+ tell_server ("PART " ^ chan ^ "\n")
+ end;
+
+Hashtbl.add cmd_managers
+ "CHANINFO"
+ begin
+ "[<#channel>]: Gets the user list for the given channel",
+ fun token tail ->
+ let chan = try token () with Not_found -> !default_channel in
+ if chan = "" then printh "E" "Need to specify a channel"
+ else
+ let chan = match String.get chan 0 with '#' | '&' -> chan | _ -> "#" ^ chan in
+ tell_server ("LIST " ^ chan ^ "\n");
+ tell_server ("NAMES " ^ chan ^ "\n")
+ end;
+
+Hashtbl.add cmd_managers
+ "NICK"
+ begin
+ "[<nick>]: Changes or requests the current nick",
+ fun token tail ->
+ try let nick = token () in tell_server ("NICK " ^ nick ^ "\n")
+ with Not_found -> printh "I" ("You current nick is " ^ !current_nick)
+ end;
+
+Hashtbl.add cmd_managers
+ "DISCONNECT"
+ begin
+ "[<message>]: Signoffs on the current server with the given quit message",
+ fun token tail ->
+ let msg = try tail () with Not_found -> (version ^ ", the light IRC client in CAML") in
+ tell_server ("QUIT :" ^ msg ^ "\n");
+ end;
+
+Hashtbl.add cmd_managers
+ "QUIT"
+ begin
+ "[<message>]: Signoffs on the current server if connected, and terminates operations",
+ fun token tail ->
+ if !server_connection != Broken then begin
+ let msg = try tail () with Not_found -> (version ^ ", the light IRC client in CAML") in
+ tell_server ("QUIT :" ^ msg ^ "\n");
+ end;
+ alive := false
+ end;
+
+Hashtbl.add cmd_managers
+ "QUOTE"
+ begin
+ "<line>: Sends the line to the server, as it is",
+ fun token tail ->
+ try tell_server (tail () ^ "\n")
+ with Not_found -> printh "E" "Missing parameter"
+ end;
+
+Hashtbl.add cmd_managers
+ "VERBOSE"
+ begin
+ ": Set the verbose mode (everything form the server will be printed)",
+ fun token tail ->
+ verbose := not !verbose;
+ if !verbose then printh "I" "Verbose mode on" else printh "I" "Verbose mode off"
+ end;
+
+(*****************************************************************************)
+(* Function to handle the various CTCPs *)
+(*****************************************************************************)
+
+Hashtbl.add ctcp_managers
+ "VERSION"
+ begin
+ fun token tail from dest -> tell_server ("NOTICE " ^ from ^ " :" ^ version ^ ", the light IRC client in CAML\n")
+ end;;
+
+Hashtbl.add ctcp_managers
+ "ACTION"
+ begin
+ fun token tail from dest -> try print ("* " ^ from ^ " " ^ (tail())) with Not_found -> print ("* " ^ from)
+ end;;
+
+(*****************************************************************************)
+(* Functions to handle the mode changes (that part of the protocole sucks) *)
+(*****************************************************************************)
+
+let rec flatten_modes = fun polarity mode_string mode_indice param_strings param_indice ->
+ if mode_indice < (String.length mode_string)
+ then begin
+ match (String.get mode_string mode_indice) with
+ '+' -> flatten_modes 1 mode_string (mode_indice+1) param_strings param_indice
+ | '-' -> flatten_modes (-1) mode_string (mode_indice+1) param_strings param_indice
+ | 'k' | 'o' | 'v' | 'b' as c ->
+ (c, polarity, param_strings.(param_indice))::(flatten_modes polarity mode_string (mode_indice+1) param_strings (param_indice+1))
+ | 'm' | 'i' | 's' | 't' | 'n' as c ->
+ (c, polarity, "")::(flatten_modes polarity mode_string (mode_indice+1) param_strings param_indice)
+ | 'l' ->
+ if polarity = 1
+ then ('l', polarity, param_strings.(param_indice))::(flatten_modes polarity mode_string (mode_indice+1) param_strings (param_indice+1))
+ else ('l', polarity, "")::(flatten_modes polarity mode_string (mode_indice+1) param_strings param_indice)
+ | other -> (other, polarity, "")::(flatten_modes polarity mode_string (mode_indice+1) param_strings param_indice)
+ end
+ else []
+;;
+
+let rec string_of_modelist = function
+ [] -> ""
+ | (c, l, p)::t ->
+ (if l > 0 then " +" else " -") ^
+ (String.make 1 c) ^
+ (if p = "" then "" else " " ^ p) ^
+ (string_of_modelist t)
+
+let set_modes channel l =
+ let chan = find_joined channel in
+ List.iter
+ begin
+ function
+ | ('b', pol, pattern) -> ()
+ | ('v', pol, nick) -> ()
+ | ('o', pol, nick) -> (Hashtbl.find chan.people nick).operator <- (pol > 0)
+ | (c, 1, param) -> Hashtbl.replace chan.modes c param
+ | (c, -1, param) -> Hashtbl.remove chan.modes c
+ | _ -> ()
+ end
+ l;;
+
+let get_status = fun () ->
+ " [" ^ version ^ "] " ^
+ (try string_of_user (Hashtbl.find (find_joined !default_channel).people !current_nick)
+ with Not_found -> "")
+ ^ !current_nick ^
+ " (+" ^
+ (if Hashtbl.mem current_modes 'i' then "i" else "") ^
+ (if Hashtbl.mem current_modes 'O' then "i" else "") ^
+ (if Hashtbl.mem current_modes 'o' then "i" else "") ^
+ (if Hashtbl.mem current_modes 'w' then "w" else "") ^
+ (if Hashtbl.mem current_modes 'a' then "a" else "") ^
+ ")" ^
+ if !default_channel = "" then ""
+ else
+ " on " ^ !default_channel ^
+ let modes = (find_joined !default_channel).modes in
+ " (+" ^
+ (if Hashtbl.mem modes 'm' then "m" else "") ^
+ (if Hashtbl.mem modes 'i' then "i" else "") ^
+ (if Hashtbl.mem modes 's' then "s" else "") ^
+ (if Hashtbl.mem modes 'n' then "n" else "") ^
+ (if Hashtbl.mem modes 't' then "t" else "") ^
+ (try " key=" ^ (Hashtbl.find modes 'k') with Not_found -> "") ^
+ (try " limit=" ^ (Hashtbl.find modes 'l') with Not_found -> "") ^
+ ")"
+;;
+
+(*****************************************************************************)
+(* Function to handle the various commands received from the server *)
+(*****************************************************************************)
+
+(* This one just write a certain token as it is *)
+
+let print_information i = fun tokens -> printh "I" tokens.(i);;
+
+(* Here is the serious stuff ... each entry is a fun able to
+ interprete the tokens given as parameters *)
+
+Hashtbl.add protocole_managers "001"
+ begin
+ fun tokens -> current_nick := tokens.(2);
+ printh "I" ("You are now connected as " ^ tokens.(2))
+ end;
+
+Hashtbl.add protocole_managers "PING"
+ begin
+ fun tokens -> tell_server ("PONG " ^ tokens.(2) ^ "\n")
+ end;
+
+Hashtbl.add protocole_managers "JOIN"
+ begin
+ fun tokens ->
+ let (nick, login, host) = split_prefix tokens.(0) in
+ if nick = !current_nick
+ then begin
+ printh ">" ("You have joined " ^ tokens.(2));
+ set_joined tokens.(2) { name=tokens.(2); people= Hashtbl.create 10; modes = Hashtbl.create 10 };
+ default_channel := tokens.(2);
+ tell_server ("MODE " ^ tokens.(2) ^ "\n")
+ end
+ else printh ">" (nick ^ " (" ^ login ^ "@" ^ host ^ ") has joined " ^ tokens.(2));
+ Hashtbl.replace (find_joined tokens.(2)).people nick { operator = false }
+ end;
+
+Hashtbl.add protocole_managers "PART"
+ begin
+ fun tokens ->
+ let (nick, login, host) = split_prefix tokens.(0) in
+ if nick = !current_nick
+ then begin
+ printh "<" ("You have left " ^ tokens.(2));
+ part_channel tokens.(2)
+ end
+ else begin
+ printh "<" (nick ^ " (" ^ login ^ "@" ^ host ^ ") has left " ^ tokens.(2));
+ Hashtbl.remove (find_joined tokens.(2)).people nick;
+ end
+ end;
+
+Hashtbl.add protocole_managers "QUIT"
+ begin
+ fun tokens -> let (nick, login, host) = split_prefix tokens.(0) in
+ let channels =
+ Hashtbl.fold
+ (fun name data s -> if Hashtbl.mem data.people nick then s ^ " " ^ data.name else s)
+ joined_channels "" in
+ printh "<" ("Signoff: " ^ nick ^ " (" ^ tokens.(2) ^ ") from" ^ channels);
+ Hashtbl.iter (fun name data -> Hashtbl.remove data.people nick) joined_channels;
+ end;
+
+Hashtbl.add protocole_managers "KICK"
+ begin
+ fun tokens ->
+ let (nick, login, host) = split_prefix tokens.(0) in
+ if tokens.(3) = !current_nick
+ then begin
+ printh "<" ("You have been kicked from " ^ tokens.(2) ^ " by " ^ nick ^ " (" ^ tokens.(4)^ ")");
+ part_channel tokens.(2)
+ end
+ else printh "<" (tokens.(3) ^ " has been kicked from " ^ tokens.(2) ^ " by " ^ nick ^ " (" ^ tokens.(4) ^ ")");
+ Hashtbl.remove (find_joined tokens.(2)).people tokens.(3);
+ end;
+
+Hashtbl.add protocole_managers "NICK"
+ begin
+ fun tokens -> let (nick, login, host) = split_prefix tokens.(0) in
+ if nick = !current_nick
+ then begin
+ printh "I" ("You are now known as " ^ tokens.(2));
+ current_nick := tokens.(2)
+ end
+ else printh "I" (nick ^ " is now known as " ^ tokens.(2));
+ let rename = begin
+ fun name data ->
+ let u = Hashtbl.find data.people nick in
+ try
+ Hashtbl.remove data.people nick;
+ Hashtbl.add data.people tokens.(2) u
+ with
+ Not_found -> ()
+ end in
+ Hashtbl.iter rename joined_channels;
+ end;
+
+Hashtbl.add protocole_managers "MODE"
+ begin
+ fun tokens ->
+ let (nick, login, host) = try split_prefix tokens.(0) with Not_found -> (tokens.(0), "", "") in
+ let modes = flatten_modes 1 tokens.(3) 0 tokens 4 in
+ if match String.get tokens.(2) 0 with '#' | '&' -> true | _ -> false
+ then
+ begin
+ set_modes (String.uppercase tokens.(2)) modes;
+ printh "I" ("Mode change by " ^ nick ^ " on channel " ^ tokens.(2) ^ (string_of_modelist modes))
+ end
+ else
+ begin
+ List.iter
+ (function (c, 1, x) -> Hashtbl.replace current_modes c x | (c, -1, x) -> Hashtbl.remove current_modes c | _ -> ())
+ modes;
+ printh "I" ("Mode change" ^ (string_of_modelist modes) ^ " by " ^ nick ^ " for user " ^ tokens.(2))
+ end
+ end;
+
+Hashtbl.add protocole_managers "TOPIC"
+ begin
+ fun tokens ->
+ let (nick, login, host) = split_prefix tokens.(0) in
+ printh "I" (nick ^ " has changed the topic on " ^ tokens.(2) ^ " to \"" ^ tokens.(3) ^ "\"")
+ end;
+
+Hashtbl.add protocole_managers "ERROR"
+ begin
+ fun tokens -> printh "E" tokens.(2)
+ end;
+
+Hashtbl.add protocole_managers "PRIVMSG"
+ begin
+ fun tokens ->
+ let (nick, login, host) = split_prefix tokens.(0) in
+ try
+ let n1 = String.index tokens.(3) '\ 1' in
+ let n2 = String.index_from tokens.(3) (n1 + 1) '\ 1' in
+ let ctcp_line = (String.sub tokens.(3) (n1 + 1) (n2 - n1 - 1)) in
+ let (ctcp_token, ctcp_tail) = tokenizer ctcp_line ' ' in
+ let cmd = ctcp_token () in
+ try
+ (Hashtbl.find ctcp_managers cmd) ctcp_token ctcp_tail nick tokens.(2)
+ with
+ Not_found -> printh "E" ("Unknown CTCP [" ^ ctcp_line ^ "] from " ^ nick);
+ tell_server ("NOTICE " ^ nick ^ " :Unknown CTCP " ^ cmd ^ "'\n")
+ with
+ Not_found ->
+ begin
+ if (String.get tokens.(2) 0) = '#'
+ then print ("<" ^ nick ^ (if same_channel tokens.(2) !default_channel then "" else ("/" ^ tokens.(2))) ^ "> " ^
+ tokens.(3))
+ else begin
+ tell_ssfe (Tabulable ("/msg " ^ nick ^ " "));
+ print ("[" ^ nick ^ "] " ^ tokens.(3))
+ end
+ end
+ end;
+
+Hashtbl.add protocole_managers "NOTICE"
+ begin
+ fun tokens ->
+ let (nick, login, host) = split_prefix tokens.(0) in
+ print ("-" ^ nick ^ (if tokens.(2) = !current_nick then "" else "/" ^ tokens.(2)) ^ "- " ^ tokens.(3))
+ end;
+
+Hashtbl.add protocole_managers "301"
+ begin
+ fun tokens -> printh "I" (tokens.(3) ^ " is away (" ^ tokens.(4) ^ ")")
+ end;
+
+Hashtbl.add protocole_managers "311"
+ begin
+ fun tokens -> printh "I" (tokens.(3) ^ " is " ^ tokens.(4) ^ "@" ^ tokens.(5) ^ " (" ^ tokens.(7) ^ ")")
+ end;
+
+Hashtbl.add protocole_managers "312"
+ begin
+ fun tokens -> printh "I" ("on IRC via server " ^ tokens.(4) ^ " (" ^ tokens.(5) ^ ")")
+ end;
+
+Hashtbl.add protocole_managers "317"
+ begin
+ fun tokens ->
+ let duration = int_of_string tokens.(4) in
+ printh "I" (tokens.(3) ^ " has been idle for " ^ (duration_of_seconds duration))
+ end;
+
+Hashtbl.add protocole_managers "319"
+ begin
+ fun tokens -> printh "I" ("on channels: " ^ tokens.(4))
+ end;
+
+Hashtbl.add protocole_managers "324"
+ begin
+ fun tokens -> set_modes tokens.(3) (flatten_modes 1 tokens.(4) 0 tokens 5)
+ end;
+
+Hashtbl.add protocole_managers "322"
+ begin
+ fun tokens -> printh "I" ("There are " ^ tokens.(4) ^ " users on " ^ tokens.(3))
+ end;
+
+Hashtbl.add protocole_managers "331"
+ begin
+ fun tokens -> printh "I" ("No topic is set on " ^ tokens.(3))
+ end;
+
+Hashtbl.add protocole_managers "333"
+ begin
+ fun tokens -> printh "I" ("Topic for " ^ tokens.(3) ^ " set by " ^ tokens.(2))
+ end;
+
+List.iter
+ begin
+ fun s -> Hashtbl.add protocole_managers s (print_information 3)
+ end
+ [ "002"; "003"; "005"; "020"; "042";
+ "251"; "252"; "253"; "255"; "265"; "266";
+ "372"; "375"; "376";
+ "422"; "451" ];
+
+Hashtbl.add protocole_managers "305"
+ begin
+ fun tokens -> printh "I" tokens.(3); Hashtbl.remove current_modes 'a'
+ end;
+
+Hashtbl.add protocole_managers "306"
+ begin
+ fun tokens -> printh "I" tokens.(3); Hashtbl.replace current_modes 'a' ""
+ end;
+
+Hashtbl.add protocole_managers "403" (print_information 4);
+
+List.iter
+ begin
+ fun s -> Hashtbl.add protocole_managers s (fun tokens -> ())
+ end
+ [ "318"; "323" ];
+
+Hashtbl.add protocole_managers "004"
+ begin
+ fun tokens -> printh "I" (tokens.(3) ^ " " ^ tokens.(4) ^ " " ^ tokens.(5) ^ " " ^ tokens.(6))
+ end;
+
+Hashtbl.add protocole_managers "254"
+ begin
+ fun tokens -> printh "I" ("There are " ^ tokens.(3) ^ " " ^ tokens.(4))
+ end;
+
+Hashtbl.add protocole_managers "332"
+ begin
+ fun tokens -> printh "I" ("Topic for " ^ tokens.(3) ^ " is '" ^ tokens.(4) ^ "'")
+ end;
+
+Hashtbl.add protocole_managers "353"
+ begin
+ fun tokens ->
+ printh "I" ("Users on " ^ tokens.(4) ^ ": " ^ tokens.(5));
+ let (n_token, n_tail) = tokenizer tokens.(5) ' '
+ and people_table = (find_joined tokens.(4)).people in
+ let rec add_nick = fun () ->
+ try
+ (let nick = n_token () in match String.get nick 0 with
+ '@' -> Hashtbl.replace people_table (String.sub nick 1 ((String.length nick) - 1)) { operator = true }
+ | _ -> Hashtbl.replace people_table nick { operator = false });
+ add_nick ()
+ with Not_found -> ()
+ in add_nick ();
+ end;
+
+Hashtbl.add protocole_managers "366"
+ begin
+ fun tokens -> ()
+ (*let users = Hashtbl.fold (fun nick status s -> " " ^ nick ^ s) (find_joined tokens.(3)).people "" in
+ printh "I" ("Users on " ^ tokens.(3) ^ ":" ^ users)*)
+ end;
+
+Hashtbl.add protocole_managers "401"
+ begin
+ fun tokens -> printh "E" ("Can not find " ^ tokens.(3) ^ " on IRC")
+ end;
+
+Hashtbl.add protocole_managers "433"
+ begin
+ fun tokens ->
+ if tokens.(2) = "*"
+ then printh "E" ("Nickname " ^ tokens.(3) ^ " already in used, type /nick <nick> to choose another one")
+ else printh "E" ("Nickname " ^ tokens.(3) ^ " already in used, you keep " ^ tokens.(2))
+ end;
+
+Hashtbl.add protocole_managers "441"
+ begin
+ fun tokens -> printh "E" (tokens.(3) ^ " is not on channel " ^ tokens.(4))
+ end;
+
+Hashtbl.add protocole_managers "461"
+ begin
+ fun tokens -> printh "E" ("Not enough parameters for " ^ tokens.(3))
+ end;
+
+Hashtbl.add protocole_managers "472"
+ begin
+ fun tokens -> printh "E" ("Mode '" ^ tokens.(3) ^ "' " ^ tokens.(4))
+ end;
+
+Hashtbl.add protocole_managers "474"
+ begin
+ fun tokens -> printh "E" ("Can not join " ^ tokens.(3) ^ " (banned)")
+ end;
+
+Hashtbl.add protocole_managers "475"
+ begin
+ fun tokens -> printh "E" (tokens.(3) ^ ": " ^ tokens.(4))
+ end;
+
+Hashtbl.add protocole_managers "482"
+ begin
+ fun tokens -> printh "E" ("You are not an operator on " ^ tokens.(3))
+ end;
+
+(*****************************************************************************)
+(* The module initialization *)
+(*****************************************************************************)
+
+try
+ Dynlink.init ();
+
+ Dynlink.add_interfaces
+ [ "Ircml"; "Buffer"; "List"; "Arg"; "String"; "Digest"; "Dynlink"; "Hashtbl"; "Sys";
+ "Connection"; "Unix"; "Pervasives"; "Array" ]
+ [ Sys.getcwd(); "/home/fleuret/local/lib/ocaml" ];
+
+with
+ Dynlink.Error error -> printh "E" ("Module loading error (" ^ (Dynlink.error_message error) ^ ")");;
+
+try ignore (Unix.tcgetattr Unix.stdout) with Unix.Unix_error _ -> print "`#ssfe#i";;
+
+(*****************************************************************************)
+(* The main loop *)
+(*****************************************************************************)
+
+print "-----------------------------------------------------------------------------";
+print (" " ^ version ^ ", the IRC client in OCAML");
+print " Written and (c) by <francois.fleuret@epfl.ch>";
+print "-----------------------------------------------------------------------------";
+
+establish_connection ();
+
+while !alive do
+
+ flush stdout;
+
+ let (reading, _, _) = Unix.select (keys fd_active) [] [] 1.0 in
+
+ List.iter
+ begin
+ fun fd ->
+ let h = Hashtbl.find fd_active fd in
+ try h.reader () with Network_error(e) -> h.error_handler e
+ end
+ reading;
+
+ tell_ssfe (Status (get_status ()))
+
+done;
+
+printh "I" "You'll be back, ho yes ... you'll be back"
projects / ircml.git / commitdiff