-
Notifications
You must be signed in to change notification settings - Fork 51
/
irc.el
1500 lines (1268 loc) · 56.2 KB
/
irc.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; irc.el --- Library to handle IRC connections -*- lexical-binding: t -*-
;; Copyright (C) 2015 Jorgen Schaefer <[email protected]>
;; Author: Jorgen Schaefer <[email protected]>
;; URL: https://github.com/emacs-circe/circe
;; 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 3
;; 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The main entry function is `irc-connect'. This creates a new
;; connection to an IRC server, and also takes an event handler table
;; which is used to run various event handlers. Handlers receive a
;; connection object which can be used for other API calls.
;; IRC connection objects also accept connection options. These can be
;; queried using `irc-connection-get', and are set by `irc-connect' or
;; later using `irc-connection-put'.
;; Event handler tables are simple maps of names to functions. See
;; `irc-handler-table', `irc-handler-add' and `irc-handler-run' for
;; the API.
;; To send commands to the server, use `irc-send-raw' or
;; `irc-send-command'.
;; The rest of the library are handler packs that add support for
;; various IRC features.
;;; Code:
(require 'cl-lib)
(require 'gnutls)
(if (fboundp 'gnutls-boot-parameters)
(declare-function 'make-tls-process 'make-tls-process)
(require 'make-tls-process))
(defvar irc-debug-log nil
"Emit protocol debug info if this is non-nil.")
;;;;;;;;;;;;;;;;;;;;;;;
;;; Connection function
(defun irc-connect (&rest keywords)
"Connect to an IRC server.
Supported keyword arguments:
:name NAME -- The name for the process
:host HOST -- The host to connect to
:service SERVICE -- The service or port to connect to
:tls BOOL -- Whether to use TLS
:family IP-FAMILY -- Force using of ipv4 or ipv6
:handler-table HANDLER -- The event handler table to send events to.
The following events are supported:
conn.connected conn -- The connection was established
conn.failed conn -- The connection could not be established
conn.disconnected conn -- A previously established connection was lost
NNN conn sender args... -- A numeric reply from IRC was received
COMMAND conn sender args... -- An IRC command message was received"
(let* ((fun (if (and (plist-get keywords :tls)
(not (fboundp 'gnutls-boot-parameters)))
'make-tls-process
'make-network-process))
(host (or (plist-get keywords :host)
(error "Must specify a :host to connect to")))
(service (or (plist-get keywords :service)
(error "Must specify a :service to connect to")))
(tls-keylist (plist-get keywords :tls-keylist))
(tls-parameters (when (and (plist-get keywords :tls)
(fboundp 'gnutls-boot-parameters))
(when (not (gnutls-available-p))
(error "gnutls support missing"))
(cons 'gnutls-x509pki
(gnutls-boot-parameters
:type 'gnutls-x509pki
:hostname host
:keylist tls-keylist))))
(proc (funcall fun
:name (or (plist-get keywords :name) host)
:host host
:service service
:family (plist-get keywords :family)
:coding 'no-conversion
:nowait (featurep 'make-network-process '(:nowait t))
:noquery t
:tls-parameters tls-parameters
:filter #'irc--filter
:sentinel #'irc--sentinel
:plist keywords
:keepalive t)))
(when (and (plist-get keywords :tls)
(fboundp 'nsm-verify-connection))
;; gnutls-verify-error must be nil for nsm to work, otherwise
;; keep it at the default value (see #405)
(let (gnutls-verify-error)
(setq proc (nsm-verify-connection proc host service)))
(when (not proc)
(error "nsm verification failed")))
;; When we used `make-network-process' without :nowait, the
;; sentinel is not called with the open event, so we do this
;; manually.
(when (eq (process-status proc) 'open)
(irc--sentinel proc "open manually"))
proc))
(defun irc-connection-get (conn propname)
"Return the value of CONN's PROPNAME property."
(process-get conn propname))
(defun irc-connection-uses-sasl-plain (conn)
"Return t if CONN uses sasl plain authentication"
(and (irc-connection-get conn :sasl-username)
(irc-connection-get conn :sasl-password)))
(defun irc-connection-uses-sasl-external (conn)
"Return t if CONN uses sasl external authentication"
(irc-connection-get conn :sasl-external))
(defun irc-connection-uses-sasl (conn)
"Return t if CONN uses sasl authentication"
(or (irc-connection-uses-sasl-plain conn)
(irc-connection-uses-sasl-external conn)))
(defun irc-connection-uses-sasl-strict (conn)
"Return t if CONN uses sasl strict authentication"
(and (irc-connection-get conn :sasl-strict)
(irc-connection-uses-sasl conn)))
(defun irc-connection-put (conn propname value)
"Change CONN's PROPNAME property to VALUE."
(process-put conn propname value))
(defun irc--sentinel (proc event)
(cond
((string-match "\\`failed" event)
(irc-event-emit proc "conn.failed"))
((string-match "\\`open" event)
(irc-event-emit proc "conn.connected"))
((string-match "\\`\\(connection broken\\|finished\\|exited abnormally\\)"
event)
(irc-event-emit proc "conn.disconnected"))
((string-match "\\`\\(deleted\\|killed\\)" event)
nil)
(t
(error "Unknown event in IRC sentinel: %S" event))))
(defvar irc--filter-running-p nil
"Non-nil when we're currently processing a message.
Yep, this is a mutex. Why would one need a mutex in Emacs, a
single-threaded application, you ask? Easy!
When, during the execution of a process filter, any piece of code
waits for process output - e.g. because they started a some
external program - Emacs will process any input from external
processes. Including the one for the filter that is currently
running.
If that process does emit output, the filter is run again, while
it is already running. If the filter is not careful, this can
cause data to arrive out of order, or get lost.")
(defun irc--filter (proc data)
"Handle data from the process."
(irc-connection-put proc :conn-data
(concat (or (irc-connection-get proc :conn-data)
"")
data))
(when (not irc--filter-running-p)
(let ((irc--filter-running-p t)
(data (irc-connection-get proc :conn-data)))
(while (string-match "\r?\n" data)
(let ((line (substring data 0 (match-beginning 0))))
(setq data (substring data (match-end 0)))
(irc-connection-put proc :conn-data data)
(irc--handle-line proc line)
(setq data (irc-connection-get proc :conn-data)))))))
(defun irc--handle-line (proc line)
"Handle a single line from the IRC server.
The command is simply passed to the event handler of the IRC
connection."
(irc-debug-out proc "S: %s" line)
(let* ((parsed (irc--parse line))
(sender (car parsed))
(command (cadr parsed))
(args (cddr parsed)))
(apply #'irc-event-emit proc command sender args)))
(defun irc--parse (line)
"Parse a line from IRC.
Returns a list: (sender command args...)
A line from IRC is a space-separated list of arguments. If the
first word starts with a colon, that's the sender. The first or
second word is the command. All further words are arguments. The
first word to start with a colon ends the argument list.
Examples:
COMMAND
COMMAND arg
COMMAND arg1 arg2
COMMAND arg1 arg2 :arg3 still arg3
:sender COMMAND arg1 arg2 :arg3 still arg3"
(with-temp-buffer
(insert line)
(goto-char (point-min))
(let ((sender nil)
(args nil))
;; Optional sender.
(when (looking-at ":\\([^ ]+\\) ")
(setq sender (decode-coding-string
(match-string 1)
'undecided))
(goto-char (match-end 0)))
;; COMMAND.
(unless (looking-at "\\([^ ]+\\)")
(error "Invalid message: %s" line))
(push (decode-coding-string (match-string 1) 'undecided)
args)
(goto-char (match-end 0))
;; Arguments.
(while (re-search-forward " :\\(.*\\)\\| \\([^ ]*\\)" nil t)
(push (decode-coding-string
(or (match-string 1)
(match-string 2))
'undecided)
args))
(cons sender (nreverse args)))))
(defun irc-userstring-nick (userstring)
"Return the nick in a given USERSTRING.
USERSTRING is a typical nick!user@host prefix as used by IRC."
(if (string-match "\\`\\([^!]+\\)!\\([^@]+\\)@\\(.*\\)\\'" userstring)
(match-string 1 userstring)
userstring))
(defun irc-userstring-userhost (userstring)
"Return the nick in a given USERSTRING.
USERSTRING is a typical nick!user@host prefix as used by IRC."
(if (string-match "\\`\\([^!]+\\)!\\([^@]+@.*\\)\\'" userstring)
(match-string 2 userstring)
nil))
(defun irc-event-emit (conn event &rest args)
"Run the event handlers for EVENT in CONN with ARGS."
(irc-debug-out conn
"E: %S %s"
event
(mapconcat (lambda (elt) (format "%S" elt))
args
" "))
(let ((handler-table (irc-connection-get conn :handler-table)))
(when handler-table
(apply #'irc-handler-run handler-table event conn event args)
(apply #'irc-handler-run handler-table nil conn event args))))
;;;;;;;;;;;;;;;;;;;;;;;
;;; Event handler table
(defun irc-handler-table ()
"Return a new event handler table."
(make-hash-table :test 'equal))
(defun irc-handler-add (table event handler)
"Add HANDLER for EVENT to the event handler table TABLE."
(puthash event
(append (gethash event table)
(list handler))
table))
(defun irc-handler-remove (table event handler)
"Remove HANDLER for EVENT to the event handler table TABLE."
(puthash event
(delete handler
(gethash event table))
table))
(defun irc-handler-run (table event &rest args)
"Run the handlers for EVENT in TABLE, passing ARGS to each."
(dolist (handler (gethash event table))
(condition-case-unless-debug err
(apply handler args)
(error
(message "Error running event %S handler %S: %S (args were %S)"
event handler err args)))))
;;;;;;;;;;;
;;; Sending
(defun irc-send-raw (conn line &optional flood-handling)
"Send a line LINE to the IRC connection CONN.
LINE should not include the trailing newline.
FLOOD-HANDLING defines how to handle the situation when we are
sending too much data. It can have three values:
nil -- Add the message to a queue and send it later
:nowait -- Send the message immediately, circumventing flood protection
:drop -- Send the message only if we are not flooding, and drop it if
we have queued up messages.
The flood protection algorithm works like the one detailed in RFC
2813, section 5.8 \"Flood control of clients\".
* If `flood-last-message' is less than the current
time, set it equal.
* While `flood-last-message' is less than `flood-margin'
seconds ahead of the current time, send a message, and
increase `flood-last-message' by `flood-penalty'."
(cond
((null flood-handling)
(irc-connection-put conn
:flood-queue
(append (irc-connection-get conn :flood-queue)
(list line)))
(irc-send--queue conn))
((eq flood-handling :nowait)
(irc-send--internal conn line))
((eq flood-handling :drop)
(let ((queue (irc-connection-get conn :flood-queue)))
(when (not queue)
(irc-connection-put conn :flood-queue (list line))
(irc-send--queue conn))))))
(defun irc-send--queue (conn)
"Send messages from the flood queue in CONN.
See `irc-send-raw' for the algorithm."
(let ((queue (irc-connection-get conn :flood-queue))
(last-message (or (irc-connection-get conn :flood-last-message)
0))
(margin (or (irc-connection-get conn :flood-margin)
10))
(penalty (or (irc-connection-get conn :flood-penalty)
3))
(now (float-time)))
(when (< last-message now)
(setq last-message now))
(while (and queue
(< last-message (+ now margin)))
(irc-send--internal conn (car queue))
(setq queue (cdr queue)
last-message (+ last-message penalty)))
(irc-connection-put conn :flood-queue queue)
(irc-connection-put conn :flood-last-message last-message)
(let ((timer (irc-connection-get conn :flood-timer)))
(when timer
(cancel-timer timer)
(irc-connection-put conn :flood-timer nil))
(when queue
(irc-connection-put conn
:flood-timer
(run-at-time 1 nil #'irc-send--queue conn))))))
(defun irc-send--internal (conn line)
"Send LINE to CONN."
(irc-debug-out conn "C: %s" line)
(process-send-string conn
(concat (encode-coding-string line 'utf-8)
"\r\n")))
(defun irc-send-command (conn command &rest args)
"Send COMMAND with ARGS to IRC connection CONN."
(irc-send-raw conn (apply #'irc--format-command command args)))
(defun irc--format-command (command &rest args)
"Format COMMAND and ARGS for IRC.
The last value in ARGS will be escaped with a leading colon if it
contains a space. All other arguments are checked to make sure
they do not contain a space."
(dolist (arg (cons command args))
(when (not (stringp arg))
(error "Argument must be a string")))
(let* ((prefix (cons command (butlast args)))
(last (last args)))
(dolist (arg prefix)
(when (string-match " " arg)
(error "IRC protocol error: Argument %S must not contain space"
arg)))
(when (and last (or (string-match " " (car last))
(string-match "^:" (car last))
(equal "" (car last))))
(setcar last (concat ":" (car last))))
(mapconcat #'identity
(append prefix last)
" ")))
(defun irc-send-AUTHENTICATE (conn arg)
"Send an AUTHENTICATE message with ARG.
See https://ircv3.net/specs/extensions/sasl-3.1
for details."
(irc-send-command conn "AUTHENTICATE" arg))
(defun irc-send-AWAY (conn &optional reason)
"Mark yourself as AWAY with reason REASON, or back if reason is nil."
(if reason
(irc-send-command conn "AWAY" reason)
(irc-send-command conn "AWAY")))
(defun irc-send-CAP (conn &rest args)
"Send a CAP message.
See https://tools.ietf.org/html/draft-mitchell-irc-capabilities-01
for details."
(apply #'irc-send-command conn "CAP" args))
(defun irc-send-INVITE (conn nick channel)
"Invite NICK to CHANNEL."
(irc-send-command conn "INVITE" nick channel))
(defun irc-send-JOIN (conn channel &optional key)
"Join CHANNEL.
If KEY is given, use it to join the password-protected channel."
(if key
(irc-send-command conn "JOIN" channel key)
(irc-send-command conn "JOIN" channel)))
(defun irc-send-NAMES (conn &optional channel)
"Retrieve user names from the server, optionally limited to CHANNEL."
(if channel
(irc-send-command conn "NAMES" channel)
(irc-send-command conn "NAMES")))
(defun irc-send-NICK (conn nick)
"Change your own nick to NICK."
(irc-send-command conn "NICK" nick))
(defun irc-send-NOTICE (conn msgtarget text-to-be-sent)
"Send a private notice containing TEXT-TO-BE-SENT to MSGTARGET.
MSGTARGET can be either a nick or a channel."
(irc-send-command conn "NOTICE" msgtarget text-to-be-sent))
(defun irc-send-PART (conn channel reason)
"Leave CHANNEL with reason REASON."
(irc-send-command conn "PART" channel reason))
(defun irc-send-PASS (conn password)
"Authenticate to the server using PASSWORD."
(irc-send-command conn "PASS" password))
(defun irc-send-PONG (conn server)
"Respond to a PING message."
(irc-send-raw conn
(irc--format-command "PONG" server)
:nowait))
(defun irc-send-PRIVMSG (conn msgtarget text-to-be-sent)
"Send a private message containing TEXT-TO-BE-SENT to MSGTARGET.
MSGTARGET can be either a nick or a channel."
(irc-send-command conn "PRIVMSG" msgtarget text-to-be-sent))
(defun irc-send-QUIT (conn reason)
"Leave IRC with reason REASON."
(irc-send-command conn "QUIT" reason))
(defun irc-send-TOPIC (conn channel &optional new-topic)
"Retrieve or set the topic of CHANNEL
If NEW-TOPIC is given, set this as the new topic. If it is
omitted, retrieve the current topic."
(if new-topic
(irc-send-command conn "TOPIC" channel new-topic)
(irc-send-command conn "TOPIC" channel)))
(defun irc-send-USER (conn user mode realname)
"Send a USER message for registration.
MODE should be an integer as per RFC 2812"
(irc-send-command conn "USER" user (format "%s" mode) "*" realname))
(defun irc-send-WHOIS (conn target &optional server-or-name)
"Retrieve current whois information on TARGET."
(if server-or-name
(irc-send-command conn "WHOIS" target server-or-name)
(irc-send-command conn "WHOIS" target)))
(defun irc-send-WHOWAS (conn target)
"Retrieve past whois information on TARGET."
(irc-send-command conn "WHOWAS" target))
(defun irc-send-STATS (conn query &optional server)
"Return statistics on current server, or SERVER if it is specified."
(if server
(irc-send-command conn "STATS" query server)
(irc-send-command conn "STATS" query)))
;;;;;;;;;;;;;;;
;;; Debug stuff
(defun irc-debug-out (conn fmt &rest args)
(when irc-debug-log
(let ((name (format "*IRC Protocol %s:%s*"
(irc-connection-get conn :host)
(irc-connection-get conn :service))))
(with-current-buffer (get-buffer-create name)
(save-excursion
(goto-char (point-max))
(insert (apply #'format fmt args) "\n"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Handler: Registration
(defun irc-handle-registration (table)
"Add command handlers to TABLE to handle registration.
This will send the usual startup messages after we are connected.
Events emitted:
\"irc.registered\" current-nick -- We have successfully
registered with the IRC server. Most commands can be used now.
In particular, joining channels is only possible now.
\"sasl.login\" nick!user@host account -- SASL log in was
successful.
Connection options used:
:nick -- The nick to use to register with the server
:user -- The user name to use
:mode -- The initial mode to use; an integer. See RFC 2812 for
the meaning.
:realname -- The realname to use for the registration
:pass -- The server password to send
:cap-req -- CAP protocol capabilities to request, if available
:sasl-username -- The SASL username to send, if sasl is available
:sasl-password -- The SASL password to send, if sasl is available
:sasl-external -- Use SASL external autentication, if sasl is available
:sasl-strict -- If sasl is available and authentication failed leave
the server.
Connection options set:
:connection-state -- One of nil, connected, registered, disconnected
See `irc-connection-state' for an interface to this.
:cap-supported-p -- Non-nil if the server supports the CAP protocol
:cap-ack -- The list of active capabilities negotiated with the server"
(irc-handler-add table "conn.connected"
#'irc-handle-registration--connected)
(irc-handler-add table "conn.disconnected"
#'irc-handle-registration--disconnected)
(irc-handler-add table "001" ;; RPL_WELCOME
#'irc-handle-registration--rpl-welcome)
(irc-handler-add table "CAP"
#'irc-handle-registration--cap)
(irc-handler-add table "AUTHENTICATE"
#'irc-handle-registration--authenticate)
(irc-handler-add table "900" ;; RPL_LOGGEDIN
#'irc-handle-registration--logged-in)
(irc-handler-add table "903" ;; RPL_SASLSUCCESS
#'irc-handle-registration--sasl-succeeded)
(irc-handler-add table "904" ;; ERR_SASLFAILED
#'irc-handle-registration--sasl-failed)
(irc-handler-add table "905" ;; ERR_SASLTOOLONG
#'irc-handle-registration--sasl-failed)
(irc-handler-add table "906" ;; ERR_SASLABORTED
#'irc-handle-registration--sasl-aborted)
(irc-handler-add table "907" ;; ERR_SASLALREADY
#'irc-handle-registration--sasl-already))
(defun irc-handle-registration--connected (conn _event)
(irc-connection-put conn :connection-state 'connected)
(when (irc-connection-get conn :cap-req)
(irc-send-CAP conn "LS"))
(let ((password (irc-connection-get conn :pass)))
(when password
(irc-send-PASS conn password)))
(irc-send-NICK conn (irc-connection-get conn :nick))
(irc-send-USER conn
(irc-connection-get conn :user)
(irc-connection-get conn :mode)
(irc-connection-get conn :realname)))
(defun irc-handle-registration--disconnected (conn _event)
(irc-connection-put conn :connection-state 'disconnected))
(defun irc-handle-registration--rpl-welcome (conn _event _sender target
&rest _ignored)
(irc-connection-put conn :connection-state 'registered)
(irc-event-emit conn "irc.registered" target))
(defun irc-handle-registration--cap (conn _event _sender _target
subcommand arg)
(cond
((equal subcommand "LS")
(let ((supported (split-string arg))
(wanted nil))
(dolist (cap (irc-connection-get conn :cap-req))
(when (member cap supported)
(setq wanted (append wanted (list cap)))))
(if wanted
(irc-send-CAP conn "REQ" (mapconcat #'identity wanted " "))
(irc-send-CAP conn "END"))))
((equal subcommand "ACK")
(let ((acked (split-string arg)))
(irc-connection-put conn :cap-ack acked)
(if (member "sasl" acked)
(cond
((irc-connection-uses-sasl-external conn)
(irc-send-AUTHENTICATE conn "EXTERNAL"))
((irc-connection-uses-sasl-plain conn)
(irc-send-AUTHENTICATE conn "PLAIN"))
(t
(irc-send-CAP conn "END")))
(irc-send-CAP conn "END"))))
(t
(message "Unknown CAP response from server: %s %s" subcommand arg))))
(defun irc-handle-registration--authenticate (conn _event _sender arg)
(if (equal arg "+")
(let ((username (irc-connection-get conn :sasl-username))
(password (irc-connection-get conn :sasl-password))
(external (irc-connection-get conn :sasl-external)))
(if external
(irc-send-AUTHENTICATE conn "+")
(irc-send-AUTHENTICATE conn (base64-encode-string
(format "%s\x00%s\x00%s"
username username password)
t))))
(message "Unknown AUTHENTICATE response from server: %s" arg)))
(defun irc-handle-registration--logged-in (conn _event _sender _target
userhost account _message)
(when (not (irc-connection-uses-sasl conn))
(irc-event-emit conn "sasl.login" userhost account)))
(defun irc-handle-registration--sasl-succeeded (conn _event _sender target
message)
(irc-send-CAP conn "END")
(irc-event-emit conn "sasl.login" target message))
(defun irc-handle-registration--sasl-failed (conn _event _sender _target
_message)
(cond
((irc-connection-uses-sasl-strict conn)
(with-current-buffer (irc-connection-get conn :server-buffer)
(setq circe-server-inhibit-auto-reconnect-p t)
(irc-send-QUIT conn circe-default-quit-message)))
(t
(irc-send-CAP conn "END"))))
(defun irc-handle-registration--sasl-aborted (conn _event _sender _target
_message)
(irc-send-CAP conn "END"))
(defun irc-handle-registration--sasl-already (conn _event _sender _target
_message)
(irc-send-CAP conn "END"))
(defun irc-connection-state (conn)
"connecting connected registered disconnected"
(let ((state (irc-connection-get conn :connection-state)))
(if (null state)
'connecting
state)))
;;;;;;;;;;;;;;;;;;;;;;
;;; Handler: Ping-Pong
(defun irc-handle-ping-pong (table)
"Add command handlers to respond to PING requests."
(irc-handler-add table "PING" #'irc-handle-ping-pong--ping))
(defun irc-handle-ping-pong--ping (conn _event _sender argument)
(irc-send-PONG conn argument))
;;;;;;;;;;;;;;;;;;;;;
;;; Handler: ISUPPORT
(defun irc-handle-isupport (table)
"Add command handlers to track 005 RPL_ISUPPORT capabilities."
(irc-handler-add table "005" #'irc-handle-isupport--005))
(defun irc-handle-isupport--005 (conn _event _sender _target &rest args)
(irc-connection-put
conn :isupport
(append (irc-connection-get conn :isupport)
(irc-handle-isupport--capabilities-to-alist args))))
(defun irc-handle-isupport--capabilities-to-alist (capabilities)
(mapcar (lambda (cap)
(if (string-match "\\`\\([^=]+\\)=\\(.*\\)\\'" cap)
(cons (match-string 1 cap)
(match-string 2 cap))
(cons cap t)))
capabilities))
(defun irc-isupport (conn capability)
"Return the value of CAPABILITY of CONN.
These capabilities are set when the server sends a 005
RPL_ISUPPORT message. The return value is either the value of the
capability, or t if it is a boolean capability that is present.
If the capability is not present, the return value is nil."
(cdr (assoc capability
(irc-connection-get conn :isupport))))
(defun irc-string-equal-p (conn s1 s2)
"Compare S1 to S2 case-insensitively.
What case means is defined by the server of CONN."
(equal (irc-isupport--case-fold conn s1)
(irc-isupport--case-fold conn s2)))
(defvar irc-isupport--ascii-table
(let ((table (make-string 128 0))
(char 0))
(while (<= char 127)
(if (and (<= ?A char)
(<= char ?Z))
(aset table char (+ char (- ?a ?A)))
(aset table char char))
(setq char (1+ char)))
table)
"A case mapping table for the ascii CASEMAPPING.")
(defvar irc-isupport--rfc1459-table
(let ((table (concat irc-isupport--ascii-table))) ; copy string
(aset table ?\[ ?\{)
(aset table ?\] ?\})
(aset table ?\\ ?\|)
(aset table ?^ ?\~)
table)
"A case mapping table for the rfc1459 CASEMAPPING.")
(defvar irc-isupport--rfc1459-strict-table
(let ((table (concat irc-isupport--ascii-table))) ; copy string
(aset table ?\[ ?\{)
(aset table ?\] ?\})
(aset table ?\\ ?\|)
table)
"A case mapping table for the rfc1459-strict CASEMAPPING.")
(defun irc-isupport--case-fold (conn s)
"Translate S to be a lower-case.
This uses the case mapping defined by the IRC server for CONN."
(with-temp-buffer
(insert s)
(let ((mapping (or (irc-isupport conn "CASEMAPPING")
"rfc1459")))
(cond
((equal mapping "rfc1459")
(translate-region (point-min)
(point-max)
irc-isupport--rfc1459-table))
((equal mapping "ascii")
(translate-region (point-min)
(point-max)
irc-isupport--ascii-table))
((equal mapping "rfc1459-strict")
(translate-region (point-min)
(point-max)
irc-isupport--rfc1459-strict-table))))
(buffer-string)))
(defun irc-channel-name-p (conn string)
"True iff STRING is a valid channel name for CONN.
This depends on the CHANTYPES setting set by the server of CONN."
(let ((chantypes (string-to-list
(or (irc-isupport conn "CHANTYPES")
"#"))))
(if (and (> (length string) 0)
(member (aref string 0) chantypes))
t
nil)))
(defun irc-nick-without-prefix (conn nick)
"Return NICK without any mode prefixes.
For example, a user with op status might be shown as @Nick. This
function would return Nick without the prefix. This uses the 005
RPL_ISUPPORT setting of PREFIX set by the IRC server for CONN."
(let ((prefixes (irc-connection-get conn :nick-prefixes)))
(when (not prefixes)
(let ((prefix-string (or (irc-isupport conn "PREFIX")
"(qaohv)~&@%+")))
(setq prefixes (string-to-list
(if (string-match "(.*)\\(.*\\)" prefix-string)
(match-string 1 prefix-string)
"~&@%+")))
(irc-connection-put conn :nick-prefixes prefixes)))
(while (and (> (length nick) 0)
(member (aref nick 0) prefixes))
(setq nick (substring nick 1)))
nick))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Handler: Initial nick acquisition
(defun irc-handle-initial-nick-acquisition (table)
"Track the current nick of the user.
Connection options used:
:nick-alternatives -- A list of nicks to try if the first attempt
does not succeed."
(irc-handler-add table "432" ;; ERR_ERRONEUSNICKNAME
#'irc-handle-initial-nick-acquisition--get-initial-nick)
(irc-handler-add table "433" ;; ERR_NICKNAMEINUSE
#'irc-handle-initial-nick-acquisition--get-initial-nick)
(irc-handler-add table "437" ;; ERR_UNAVAILRESOURCE
#'irc-handle-initial-nick-acquisition--get-initial-nick))
(defun irc-handle-initial-nick-acquisition--get-initial-nick
(conn _event _sender current-nick _attempted-nick _reason)
(when (equal current-nick "*")
(let ((alternatives (irc-connection-get conn :nick-alternatives)))
(if (not alternatives)
(irc-send-NICK conn (irc-generate-nick))
(irc-connection-put conn :nick-alternatives (cdr alternatives))
(irc-send-NICK conn (car alternatives))))))
(defun irc-generate-nick ()
"Return a random, valid IRC nick name.
Valid nick names are at least (RFC 1459):
<nick> ::= <letter> { <letter> | <number> | <special> }
<special> ::= '-' | '[' | ']' | '\' | '`' | '^' | '{' | '}'"
(let ((chars "abcdefghijklmnopqrstuvwxyz"))
(mapconcat (lambda (_)
(make-string 1 (aref chars (random (length chars)))))
(make-string 9 0)
"")))
;;;;;;;;;;;;;;;;;
;;; Handler: CTCP
(defun irc-handle-ctcp (table)
"Add command handlers to TABLE to handle the CTCP protocol.
Connection options used:
:ctcp-version -- The response to a CTCP VERSION request.
:ctcp-clientinfo -- The response to a CTCP CLIENTINFO request.
:ctcp-source -- The response to a CTCP SOURCE request.
Events emitted:
\"irc.message\" sender target body -- A non-CTCP PRIVMSG
\"irc.notice\" sender target body -- A non-CTCP NOTICE
\"irc.ctcp\" sender target verb argument -- A CTCP request. ARGUMENT
can be nil if there was no argument, or the empty string if the
argument was empty.
\"irc.ctcpreply\" sender target verb argument -- A CTCP reply.
ARGUMENT is similar to above.
\"irc.ctcp.VERB\" sender target argument -- A CTCP request of
this specific type.
\"irc.ctcpreply.VERB\" sender target argument -- A CTCP reply of
this specific type."
(irc-handler-add table "PRIVMSG"
#'irc-handle-ctcp--privmsg)
(irc-handler-add table "irc.ctcp"
#'irc-handle-ctcp--ctcp)
(irc-handler-add table "NOTICE"
#'irc-handle-ctcp--notice)
(irc-handler-add table "irc.ctcpreply"
#'irc-handle-ctcp--ctcpreply)
(irc-handler-add table "irc.ctcp.VERSION"
#'irc-handle-ctcp--ctcp-version)
(irc-handler-add table "irc.ctcp.CLIENTINFO"
#'irc-handle-ctcp--ctcp-clientinfo)
(irc-handler-add table "irc.ctcp.SOURCE"
#'irc-handle-ctcp--ctcp-source)
(irc-handler-add table "irc.ctcp.PING"
#'irc-handle-ctcp--ctcp-ping)
(irc-handler-add table "irc.ctcp.TIME"
#'irc-handle-ctcp--ctcp-time)
)
(defun irc-handle-ctcp--privmsg (conn _event sender target body)
(if (string-match "\\`\x01\\([^ ]+\\)\\(?: \\(.*\\)\\)?\x01\\'"
body)
(irc-event-emit conn "irc.ctcp" sender target
(match-string 1 body)
(match-string 2 body))
(irc-event-emit conn "irc.message" sender target body)))
(defun irc-handle-ctcp--ctcp (conn _event sender target verb argument)
(irc-event-emit conn
(format "irc.ctcp.%s" (upcase verb))
sender
target
argument))
(defun irc-handle-ctcp--notice (conn _event sender target body)
(if (string-match "\\`\x01\\([^ ]+\\)\\(?: \\(.*\\)\\)?\x01\\'"
body)
(irc-event-emit conn "irc.ctcpreply" sender target
(match-string 1 body)
(match-string 2 body))
(irc-event-emit conn "irc.notice" sender target body)))
(defun irc-handle-ctcp--ctcpreply (conn _event sender target verb argument)
(irc-event-emit conn
(format "irc.ctcpreply.%s" (upcase verb))
sender
target
argument))
(defun irc-handle-ctcp--ctcp-version (conn _event sender _target _argument)
(let ((version (irc-connection-get conn :ctcp-version)))
(when version
(irc-send-ctcpreply conn
(irc-userstring-nick sender)
"VERSION"
version))))
(defun irc-handle-ctcp--ctcp-clientinfo (conn _event sender _target _argument)
(let ((clientinfo (irc-connection-get conn :ctcp-clientinfo)))
(when clientinfo
(irc-send-ctcpreply conn
(irc-userstring-nick sender)
"CLIENTINFO"
clientinfo))))
(defun irc-handle-ctcp--ctcp-source (conn _event sender _target _argument)
(let ((source (irc-connection-get conn :ctcp-source)))
(when source
(irc-send-ctcpreply conn
(irc-userstring-nick sender)
"SOURCE"
source))))
(defun irc-handle-ctcp--ctcp-ping (conn _event sender _target argument)
(when argument
(irc-send-ctcpreply conn
(irc-userstring-nick sender)
"PING"
argument)))
(defun irc-handle-ctcp--ctcp-time (conn _event sender _target _argument)
(irc-send-ctcpreply conn
(irc-userstring-nick sender)
"TIME"
(current-time-string)))
(defun irc-send-ctcp (conn target verb &optional argument)
"Send a CTCP VERB request to TARGET, optionally with ARGUMENT."
(irc-send-PRIVMSG conn
target
(format "\x01%s%s\x01"
verb
(if argument
(concat " " argument)
""))))
(defun irc-send-ctcpreply (conn target verb &optional argument)
"Send a CTCP VERB reply to TARGET, optionally with ARGUMENT."
(irc-send-raw conn
(irc--format-command "NOTICE"
target
(format "\x01%s%s\x01"
verb
(if argument
(concat " " argument)
"")))
:drop))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Handler: State tracking
(defun irc-handle-state-tracking (table)
"Add command handlers to TABLE to track the IRC state.
Connection options used: