home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Applications / ircle 1.5.1 / source / ircle sources / CTCP.p < prev    next >
Encoding:
Text File  |  1993-11-15  |  5.2 KB  |  221 lines  |  [TEXT/PJMM]
  1. {    ircle - Internet Relay Chat client    }
  2. {    File: CTCP    }
  3. {    Copyright © 1992 Olaf Titz (s_titz@ira.uka.de)    }
  4.  
  5. {    This program is free software; you can redistribute it and/or modify    }
  6. {    it under the terms of the GNU General Public License as published by    }
  7. {    the Free Software Foundation; either version 2 of the License, or    }
  8. {    (at your option) any later version.    }
  9.  
  10. {    This program is distributed in the hope that it will be useful,    }
  11. {    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
  12. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
  13. {    GNU General Public License for more details.    }
  14.  
  15. {    You should have received a copy of the GNU General Public License    }
  16. {    along with this program; if not, write to the Free Software    }
  17. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }
  18.  
  19. unit CTCP;
  20. { Handles CTCP messages }
  21.  
  22. interface
  23. uses
  24.     TCPTypes, TCPStuff, TCPConnections, MiscGlue, MsgWindows,{}
  25.     IRCGlobals, IRCaux, IRCChannels, IRCCommands, DCC;
  26.  
  27. procedure doCTCP (var from, target, s: string; isReply: boolean);
  28. { This handles possible CTCP messages - return empty if processed }
  29.  
  30. implementation
  31. { Special thanks to Klaus Zeuge for providing protocol documentation }
  32.  
  33. var
  34.     comm, rest: str255;
  35.  
  36. procedure quote (var s: string);
  37.     var
  38.         i: integer;
  39.     begin
  40.         i := 1;
  41.         while i <= length(s) do begin
  42.             case ord(s[i]) of
  43.                 0: 
  44.                     begin
  45.                     s[i] := chr(16);
  46.                     insert('0', s, i + 1);
  47.                 end;
  48.                 10: 
  49.                     begin
  50.                     s[i] := chr(16);
  51.                     insert('n', s, i + 1);
  52.                 end;
  53.                 13: 
  54.                     begin
  55.                     s[i] := chr(16);
  56.                     insert('r', s, i + 1);
  57.                 end;
  58.                 16: 
  59.                     begin
  60.                     i := i + 1;
  61.                     s[i] := chr(16);
  62.                     insert(chr(16), s, i);
  63.                 end;
  64.                 otherwise
  65.                     begin
  66.                 end;
  67.             end;
  68.             i := i + 1;
  69.         end;
  70.     end;
  71.  
  72.  
  73. procedure unquote (var s: string);
  74.     var
  75.         i: integer;
  76.     begin
  77.         repeat
  78.             i := pos(chr(16), s);
  79.             if i = 0 then
  80.                 leave;
  81.             if i = length(s) then
  82.                 s[0] := chr(i - 1)
  83.             else begin
  84.                 case ord(s[i + 1]) of
  85.                     48: { 0 }
  86.                         s[i + 1] := chr(0);
  87.                     110:  { n }
  88.                         s[i + 1] := chr(10);
  89.                     114:  { r }
  90.                         s[i + 1] := chr(13);
  91.                     16: { Ctrl-P }
  92.                         s[i + 1] := chr(16);
  93.                     otherwise
  94.                         begin
  95.                     end;
  96.                 end;
  97.                 delete(s, i, 1);
  98.             end;
  99.         until false;
  100.     end;
  101.  
  102. procedure CTCPComm (var fr, ta: string; var co, re: str255);
  103.     var
  104.         tt: longint;
  105.         i: integer;
  106.         st: str255;
  107.     procedure reply;
  108.         begin
  109.             quote(st);
  110.             st := concat('NOTICE ', fr, ' :', chr(1), co, ' ', st, chr(1));
  111.             if serverStatus = S_CONN then
  112.                 PutLine(st);
  113.         end;
  114.     begin
  115.         UprString(co, false);
  116.         if co = 'ACTION' then begin
  117.             st := concat(fr, ' ', re);
  118.             ChannelMsg(ta, st)
  119.         end
  120.         else if co = 'CLIENTINFO' then begin
  121.             i := pos(' ', re);
  122.             if i > 0 then
  123.                 re[0] := chr(i - 1);
  124.             UprString(re, false);
  125.             if re = 'ACTION' then
  126.                 st := 'ACTION contains action descriptions for atmosphere'
  127.             else if re = 'CLIENTINFO' then
  128.                 st := 'CLIENTINFO gives information about available CTCP commands'
  129.             else if re = 'DCC' then
  130.                 st := 'DCC requests a direct client connection'
  131.             else if re = 'ECHO' then
  132.                 st := 'ECHO returns the arguments it receives'
  133.             else if re = 'ERRMSG' then
  134.                 st := 'ERRMSG returns error messages'
  135.             else if re = 'FINGER' then
  136.                 st := 'FINGER shows login name and idle time of user'
  137.             else if re = 'PING' then
  138.                 st := 'PING returns the arguments it receives'
  139.             else if re = 'TIME' then
  140.                 st := 'TIME shows local time of client'
  141.             else if re = 'VERSION' then
  142.                 st := 'VERSION shows information about client version'
  143.             else
  144.                 st := 'ACTION CLIENTINFO DCC ERRMSG FINGER VERSION :Use CLIENTINFO <command> to get information about specific command';
  145.             reply;
  146.         end
  147.         else if co = 'DCC' then
  148.             DCCrequest(fr, re)
  149.         else if (co = 'ECHO') or (co = 'PING') then begin
  150.             st := re;
  151.             reply
  152.         end
  153.         else if co = 'ERRMSG' then begin
  154.             st := concat(re, ' :no error');
  155.             reply
  156.         end
  157.         else if co = 'FINGER' then begin
  158.             getdatetime(tt);
  159.             st := stringof(re, ' :', default^^.userLoginName, ' :idle ', abs(tt - idleTime) : 1, ' second(s)');
  160.             reply
  161.         end
  162.         else if co = 'TIME' then begin
  163.             getdatetime(tt);
  164.             IUTimeString(tt, false, st);
  165.             reply
  166.         end
  167.         else if co = 'VERSION' then begin
  168.             st := concat('ircle :', CL_VERSION, ' :Apple Macintosh (tm)');
  169.             reply
  170.         end
  171.         else begin
  172.             st := concat('*** Unknown CTCP from ', fr, ': ', co, ' ', re);
  173.             Message(st);
  174.             st := concat(co, ' :unknown query');
  175.             co := 'ERRMSG';
  176.             reply
  177.         end;
  178.     end;
  179.  
  180. procedure CTCPReply (var fr, ta: string; var co, re: str255);
  181.     var
  182.         l1, l2: longint;
  183.         st: string;
  184.     begin
  185.         if co = 'PING' then begin
  186.             StringToNum(re, l1);
  187.             GetDateTime(l2);
  188.             st := stringof('CPING time for ', fr, ' : ', l2 - l1 : 1, ' second(s)');
  189.         end
  190.         else
  191.             st := concat('CTCP ', co, ' reply from ', fr, ' : ', re);
  192.         Message(st);
  193.     end;
  194.  
  195. procedure doCTCP (var from, target, s: string; isReply: boolean);
  196.     var
  197.         i, j, k: integer;
  198.     begin
  199.         repeat
  200.             i := pos(chr(1), s);
  201.             if i = 0 then
  202.                 leave;
  203.             comm := copy(s, i + 1, 255);
  204.             j := pos(chr(1), comm);
  205.             if j = 0 then
  206.                 j := 254;
  207.             k := pos(' ', comm);
  208.             if k = 0 then
  209.                 k := j;
  210.             rest := copy(comm, k + 1, j - k - 1);
  211.             comm[0] := chr(k - 1);
  212.             delete(s, i, j + 1);
  213.             unquote(rest);
  214.             if isReply then
  215.                 CTCPReply(from, target, comm, rest)
  216.             else
  217.                 CTCPComm(from, target, comm, rest);
  218.         until false;
  219.     end;
  220.  
  221. end.