-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathaichat-util.el
1473 lines (1350 loc) · 64.3 KB
/
aichat-util.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
;;; aichat-util.el --- aichat-util -*- lexical-binding: t; -*-
;; Filename: aichat-util.el
;; Description: aichat-util
;; Author: xhcoding <[email protected]>
;; Maintainer: xhcoding <[email protected]>
;; Copyright (C) 2023, xhcoding, all rights reserved.
;; Created: 2023-03-04 22:04:05
;; Version: 0.1
;; Last-Updated: 2023-03-04 22:04:05
;; By: xhcoding
;; URL: https://github.com/xhcoding/emacs-aichat
;; Keywords:
;; Compatibility: GNU Emacs 30.0.50
;;
;; Features that might be required by this library:
;;
;;
;;
;;; This file is NOT part of GNU Emacs
;;; License
;;
;; 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, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; aichat-util
;;
;;; Installation:
;;
;; Put aichat-util.el to your load-path.
;; The load-path is usually ~/elisp/.
;; It's set in your ~/.emacs like this:
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
;;
;; And the following to your ~/.emacs startup file.
;;
;; (require 'aichat-util)
;;
;; No need more.
;;; Customize:
;;
;;
;;
;; All of the above can customize by:
;; M-x customize-group RET aichat-util RET
;;
;;; Change log:
;;
;; 2023/03/04
;; * First released.
;;
;;; Acknowledgements:
;;
;;
;;
;;; TODO
;;
;;
;;
;;; Require
(eval-when-compile (require 'cl-lib))
(require 'rx)
(require 'url)
(require 'url-http)
(require 'json)
(require 'seq)
(require 'async-await)
;; setup url library, avoid set cookie failed
(url-do-setup)
;;; Code:
(defcustom aichat-debug nil
"When set to `t', it will output more debug message in the *AICHAT-DEBUG* buffer."
:group 'aichat
:type 'boolean)
(defcustom aichat-user-agent "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 Safari/537.36 Edg/118.0.2088.57"
"`aichat-user-agent' is used to set the value of User-Agent."
:group 'aichat
:type 'string)
(defcustom aichat-http-backend 'curl
"Http backend, curl or url."
:group 'aichat
:type '(radio
(const :tag "curl" curl)
(const :tag "url" url)))
(defcustom aichat-browser-name 'edge
"Browser used by rookiepy."
:group 'aichat-bingai
:type '(radio
(const :tag "Chrome" chrome)
(const :tag "Firefox" firefox)
(const :tag "LibreWolf" librewolf)
(const :tag "Opera" opera)
(const :tag "Opera GX" opera_gx)
(const :tag "Edge" edge)
(const :tag "Chromium" chromium)
(const :tag "Brave" brave)
(const :tag "Vivaldi" vivaldi)
(const :tag "Safari" safari)))
;;;###autoload
(defun aichat-toggle-debug ()
"Toggle debug mode."
(interactive)
(cond
(aichat-debug
(setq aichat-debug nil
url-debug nil
websocket-debug nil)
(message "Turn off aichat debug mode."))
(t
(setq aichat-debug t
url-debug t
websocket-debug t)
(message "Turn on aichat debug mode"))))
(defun aichat-debug (str &rest args)
"Print debug message to *AICHAT-DEBUG* buffer when `aichat-debug' is set `t'"
(when aichat-debug
(with-current-buffer (get-buffer-create "*AICHAT-DEBUG*")
(goto-char (point-max))
(insert (apply #'format str args) "\n"))))
(defun aichat-uuid ()
"Return string with random (version 4) UUID."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
(random)
(time-convert nil 'list)
(user-uid)
(emacs-pid)
(user-full-name)
user-mail-address
(recent-keys)))))
(format "%s-%s-4%s-%s%s-%s"
(substring rnd 0 8)
(substring rnd 8 12)
(substring rnd 13 16)
(format "%x"
(logior
#b10000000
(logand
#b10111111
(string-to-number
(substring rnd 16 18) 16))))
(substring rnd 18 20)
(substring rnd 20 32))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Basic Utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun aichat-read-region-or-input (input-prompt)
"Read string from region or input."
(if (use-region-p)
(buffer-substring (region-beginning) (region-end))
(read-string input-prompt)))
(defun aichat-read-header-value (header-key headers-alist)
"Read header value with HEADER-KEY in HEADERS-ALIST."
(alist-get header-key headers-alist nil nil '(lambda (o1 o2)
(string= (downcase o1) (downcase o2)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; JSON utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro aichat-json-serialize (params)
"Serialize object to json string."
(if (progn
(require 'json)
(and (fboundp 'json-serialize)
(> emacs-major-version 27)))
`(json-serialize ,params
:null-object nil
:false-object :json-false)
`(let ((json-false :json-false))
(json-encode ,params))))
(defmacro aichat-json-parse (str)
"Parse json string STR."
(if (progn
(require 'json)
(fboundp 'json-parse-string))
`(json-parse-string ,str
:object-type 'alist
:null-object nil
:false-object nil)
`(let ((json-array-type 'vector)
(json-object-type 'alist)
(json-false nil))
(json-read-from-string ,str))))
(defun aichat-json-parse-file (file)
"Read the JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
(aichat-json-parse (buffer-string))))
(defmacro aichat-json-access (object str)
"Access json element with {object}[array-index]."
(let ((res object)
(start-pos 0))
(cl-loop for index from 0 to (1- (length str))
do (let ((ch (aref str index)))
(cond
((or (= ch 123) (= ch 91))
(setq start-pos index))
((= ch 125)
(setq res `(alist-get ',(intern (substring str (1+ start-pos) index)) ,res)))
((= ch 93)
(setq res `(aref ,res ,(string-to-number (substring str (1+ start-pos) index))))))))
res))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Process utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(async-defun aichat-start-process (program &rest args)
"Async start process with PROGRAM and ARGS.
Returns stdout on success, otherwise returns nil."
(aichat-debug "Start process: %s with %s" program args)
(condition-case reason
(car (await (promise:make-process-with-handler (cons program args) nil t)))
(error nil)))
(async-defun aichat-shell-command (command &optional dir)
"Async run COMMAND in DIR or `default-directory'.
Returns stdout on success, otherwise returns nil."
(aichat-debug "Shell command: %s in %s" command dir)
(condition-case reason
(let ((default-directory (or dir default-directory)))
(await (promise:make-shell-command command dir)))
(error nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Cookie utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(async-defun aichat--check-deps ()
"Check if rookiepy is installed."
(when-let ((installed (await (aichat-shell-command "python -c \"import rookiepy\""))))
t))
(defun aichat-get-cookies-from-file (filename)
"Get cookies from FILENAME."
(if (file-exists-p filename)
(let ((cookies (aichat-json-parse-file filename)))
(mapcar (lambda (cookie)
(let ((name (alist-get 'name cookie))
(value (alist-get 'value cookie))
(expires (if (assq 'expirationDate cookie)
(format-time-string "%FT%T%z"
(seconds-to-time
(alist-get 'expirationDate cookie)))
nil))
(domain (alist-get 'domain cookie))
(localpart (alist-get 'path cookie))
(secure (if (eq (alist-get 'secure cookie) :json-false)
nil
t)))
(list name value expires domain localpart secure)))
cookies))
(error "%s not exists" filename)))
(defun aichat--make-get-cookies-command(domain browser-name)
"Make shell command with `domain' and `browser-name'."
(format "python -c \"import rookiepy;list(map(lambda c: print('{} {} {} {} {} {}'.format(c['name'], c['value'], c['expires'], c['domain'], c['path'], c['secure'])), filter(lambda c: c['domain'] in ('%s'), rookiepy.%s(['%s']))))\""
domain
browser-name
domain))
(async-defun aichat-get-cookies-from-shell (domain browser-name)
"Get cookies from shell command with rookiepy."
(if (not (await (aichat--check-deps)))
(message "Please install rookiepy by `pip3 install rookiepy`")
(when-let ((stdout (await
(aichat-shell-command
(aichat--make-get-cookies-command domain browser-name)))))
(mapcar (lambda (line)
(let* ((fields (split-string line " " t))
(name (nth 0 fields))
(value (nth 1 fields))
(expires (if (string= (nth 2 fields) "None")
nil
(format-time-string "%FT%T%z" (seconds-to-time (string-to-number (nth 2 fields))))))
(domain (nth 3 fields))
(localpart (nth 4 fields))
(secure (if (string= (nth 5 fields) "1")
t
nil)))
(list name value expires domain localpart secure)))
(split-string stdout "\n" t)))))
(async-defun aichat-get-cookies (domain &optional cookie-file)
"If `cookie-file' is non-nil, get cookies from `cookie-file', otherwise get cookies from shell."
(await nil)
(if cookie-file
(aichat-get-cookies-from-file cookie-file)
(await (aichat-get-cookies-from-shell domain aichat-browser-name))))
(async-defun aichat-refresh-cookies (domain &optional cookie-file)
"Refresh `domain' cookies.
Delete all cookies from the cookie store where the domain matches `domain'.
Re-fetching cookies from `domain'"
(when-let ((cookies (await (aichat-get-cookies domain cookie-file))))
(aichat-debug "%s cookies:\n%s\n" domain cookies)
(ignore-errors (url-cookie-delete-cookies domain))
(dolist (cookie cookies)
(apply #'url-cookie-store cookie))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; HTTP utils ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst aichat--http-response-status-line-regexp
(rx "HTTP/" (group (or "1.0" "1.1" "2")) " "
;; Status code
(group (1+ digit)) " "
;; Reason phrase
(optional (group (1+ (not (any "\r\n")))))
(or
;; HTTP 1
"\r\n"
;; HTTP 2
"\n"))
"Regular expression matching HTTP response status line.")
(defconst aichat--http-end-of-headers-regexp
(rx (or "\r\n\r\n" "\n\n" "\r\n\n"))
"Regular expression matching the end of HTTP headers.
This must work with both HTTP/1 (using CRLF) and HTTP/2 (using
only LF).")
(defun aichat--http-urlencode-alist (alist)
"Hexify ALIST fields according to RFC3986."
(cl-loop for sep = "" then "&"
for (k . v) in alist
concat sep
concat (url-hexify-string (format "%s" k))
concat "="
concat (url-hexify-string (format "%s" v))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; url-backend ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun aichat--http-report-data (&rest _)
"Report http data for stream request."
;; (message "buffer:\n|%s|" (buffer-string))
;; (message "report point - point-max:\n|%s|" (buffer-substring aichat--http-report-point (point-max)))
(unless aichat--http-reported-header-p
(save-mark-and-excursion
(goto-char (point-min))
(when (re-search-forward "^HTTP/[1-9]\\.?[0-9]? \\([0-9]\\{3\\}\\) \\([a-zA-Z ]*\\)" url-http-end-of-headers t)
(setq-local aichat--http-response-status (cons (match-string 1) (match-string 2)))
(when aichat--http-response-callback
(funcall aichat--http-response-callback 'status aichat--http-response-status)))
(while (re-search-forward "^\\([^:]*\\): \\(.+\\)"
url-http-end-of-headers t)
(let ((header-key (match-string 1))
(header-value (match-string 2)))
(push (cons header-key header-value)
aichat--http-response-headers)
(when (string= "content-length" (downcase header-key))
(setq-local aichat--http-response-chunked-p nil))))
(when aichat--http-response-callback
(funcall aichat--http-response-callback 'headers aichat--http-response-headers)))
(setq-local aichat--http-report-point (min (+ 1 url-http-end-of-headers) (point-max)))
(setq-local aichat--http-reported-header-p t))
(when-let* ((point-end (if aichat--http-response-chunked-p (- (point-max) 2) (point-max)))
(body (buffer-substring aichat--http-report-point point-end)))
(unless (string-empty-p body)
(when aichat--http-response-callback
(funcall aichat--http-response-callback 'body body))
(setq-local aichat--http-response-body (concat aichat--http-response-body body)))
(setq-local aichat--http-report-point point-end)))
;;; The following functions are copied from the url-http.el
(defun aichat--url-http-create-request ()
"Create an HTTP request for `url-http-target-url'.
Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')."
(let* ((extra-headers)
(request nil)
(no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
(using-proxy url-http-proxy)
(proxy-auth (if (or (cdr-safe (assoc "Proxy-Authorization"
url-http-extra-headers))
(not using-proxy))
nil
(let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
(url-get-authentication url-http-proxy nil 'any nil))))
(real-fname (url-filename url-http-target-url))
(host (url-host url-http-target-url))
(auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
nil
(url-get-authentication (or
(and (boundp 'proxy-info)
proxy-info)
url-http-target-url) nil 'any nil)))
(ref-url (url-http--encode-string url-http-referer)))
(if (equal "" real-fname)
(setq real-fname "/"))
(setq no-cache (and no-cache (string-match "no-cache" no-cache)))
(if auth
(setq auth (concat "Authorization: " auth "\r\n")))
(if proxy-auth
(setq proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n")))
;; Protection against stupid values in the referrer
(if (and ref-url (stringp ref-url) (or (string= ref-url "file:nil")
(string= ref-url "")))
(setq ref-url nil))
;; url-http-extra-headers contains an assoc-list of
;; header/value pairs that we need to put into the request.
(setq extra-headers (mapconcat
(lambda (x)
(concat (car x) ": " (cdr x)))
url-http-extra-headers "\r\n"))
(if (not (equal extra-headers ""))
(setq extra-headers (concat extra-headers "\r\n")))
;; This was done with a call to `format'. Concatenating parts has
;; the advantage of keeping the parts of each header together and
;; allows us to elide null lines directly, at the cost of making
;; the layout less clear.
(setq request
(concat
;; The request
(or url-http-method "GET") " "
(url-http--encode-string
(if (and using-proxy
;; Bug#35969.
(not (equal "https" (url-type url-http-target-url))))
(let ((url (copy-sequence url-http-target-url)))
(setf (url-host url) (puny-encode-domain (url-host url)))
(url-recreate-url url))
real-fname))
" HTTP/" url-http-version "\r\n"
;; Version of MIME we speak
"MIME-Version: 1.0\r\n"
;; (maybe) Try to keep the connection open
"Connection: " (if (or using-proxy
(not url-http-attempt-keepalives))
"close" "keep-alive") "\r\n"
;; HTTP extensions we support
(if url-extensions-header
(format
"Extension: %s\r\n" url-extensions-header))
;; Who we want to talk to
(if (/= (url-port url-http-target-url)
(url-scheme-get-property
(url-type url-http-target-url) 'default-port))
(format
"Host: %s:%d\r\n" (url-http--encode-string
(puny-encode-domain host))
(url-port url-http-target-url))
(format "Host: %s\r\n"
(url-http--encode-string (puny-encode-domain host))))
;; Who its from
(if url-personal-mail-address
(concat
"From: " url-personal-mail-address "\r\n"))
;; Encodings we understand
(if (or url-mime-encoding-string
;; MS-Windows loads zlib dynamically, so recheck
;; in case they made it available since
;; initialization in url-vars.el.
(and (eq 'system-type 'windows-nt)
(fboundp 'zlib-available-p)
(zlib-available-p)
(setq url-mime-encoding-string "gzip")))
(concat
"Accept-encoding: " url-mime-encoding-string "\r\n"))
(if url-mime-charset-string
(concat
"Accept-charset: "
(url-http--encode-string url-mime-charset-string)
"\r\n"))
;; Languages we understand
(if url-mime-language-string
(concat
"Accept-language: " url-mime-language-string "\r\n"))
;; Types we understand
"Accept: " (or url-mime-accept-string "*/*") "\r\n"
;; User agent
(url-http-user-agent-string)
;; Proxy Authorization
proxy-auth
;; Authorization
auth
;; Cookies
(when (url-use-cookies url-http-target-url)
(url-http--encode-string
(url-cookie-generate-header-lines
host real-fname
(equal "https" (url-type url-http-target-url)))))
;; If-modified-since
(if (and (not no-cache)
(member url-http-method '("GET" nil)))
(let ((tm (url-is-cached url-http-target-url)))
(if tm
(concat "If-modified-since: "
(url-get-normalized-date tm) "\r\n"))))
;; Whence we came
(if ref-url (concat
"Referer: " ref-url "\r\n"))
extra-headers
;; Length of data
(if url-http-data
(concat
"Content-length: " (number-to-string
(length (encode-coding-string url-http-data 'utf-8)))
"\r\n"))
;; End request
"\r\n"
;; Any data
url-http-data))
;; Bug#23750
;; (unless (= (string-bytes request)
;; (length request))
;; (error "Multibyte text in HTTP request: %s" request))
(url-http-debug "Request is: \n%s" request)
request))
(defun aichat--url-display-message (fmt &rest args)
"Like `message', but do nothing if `url-show-status' is nil."
(when (and url-show-status
(not (and url-current-object (url-silent url-current-object)))
fmt)
(apply #'message fmt args)))
(defun aichat--url-http-content-length-after-change-function (_st nd _length)
"Function used when we DO know how long the document is going to be.
More sophisticated percentage downloaded, etc.
Also does minimal parsing of HTTP headers and will actually cause
the callback to be triggered."
(if url-http-content-type
(aichat--url-display-message
"Reading [%s]... %s of %s (%d%%)"
url-http-content-type
(funcall byte-count-to-string-function (- nd url-http-end-of-headers))
(funcall byte-count-to-string-function url-http-content-length)
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length))
(aichat--url-display-message
"Reading... %s of %s (%d%%)"
(funcall byte-count-to-string-function (- nd url-http-end-of-headers))
(funcall byte-count-to-string-function url-http-content-length)
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length)))
(if (> (- nd url-http-end-of-headers) url-http-content-length)
(progn
;; Found the end of the document! Wheee!
(url-lazy-message "Reading... done.")
(if (url-http-parse-headers)
;; add this line
(progn
(aichat--http-report-data)
(url-http-activate-callback))))))
(defun aichat--url-http-chunked-encoding-after-change-function (st nd length)
"Function used when dealing with chunked encoding.
Cannot give a sophisticated percentage, but we need a different
function to look for the special 0-length chunk that signifies
the end of the document."
(if url-http-chunked-last-crlf-missing
(progn
(goto-char url-http-chunked-last-crlf-missing)
(if (not (looking-at "\r\n"))
(url-http-debug
"Still spinning for the terminator of last chunk...")
(url-http-debug "Saw the last CRLF.")
(delete-region (match-beginning 0) (match-end 0))
(when (url-http-parse-headers)
(url-http-activate-callback))))
(save-excursion
(goto-char st)
(let ((read-next-chunk t)
(case-fold-search t)
(regexp nil)
(no-initial-crlf nil))
;; We need to loop thru looking for more chunks even within
;; one after-change-function call.
(while read-next-chunk
(setq no-initial-crlf (= 0 url-http-chunked-counter))
(url-http-debug "Reading chunk %d (%d %d %d)"
url-http-chunked-counter st nd length)
(setq regexp (if no-initial-crlf
"\\([0-9a-z]+\\).*\r?\n"
"\r?\n\\([0-9a-z]+\\).*\r?\n"))
(if url-http-chunked-start
;; We know how long the chunk is supposed to be, skip over
;; leading crap if possible.
(if (> nd (+ url-http-chunked-start url-http-chunked-length))
(progn
(url-http-debug "Got to the end of chunk #%d!"
url-http-chunked-counter)
(goto-char (+ url-http-chunked-start
url-http-chunked-length)))
(url-http-debug "Still need %d bytes to hit end of chunk"
(- (+ url-http-chunked-start
url-http-chunked-length)
nd))
(setq read-next-chunk nil)))
(if (not read-next-chunk)
(url-http-debug "Still spinning for next chunk...")
(if no-initial-crlf (skip-chars-forward "\r\n"))
(if (not (looking-at regexp))
(progn
;; Must not have received the entirety of the chunk header,
;; need to spin some more.
(url-http-debug "Did not see start of chunk @ %d!" (point))
(setq read-next-chunk nil))
;; The data we got may have started in the middle of the
;; initial chunk header, so move back to the start of the
;; line and re-compute.
(when (= url-http-chunked-counter 0)
(beginning-of-line)
(looking-at regexp))
(add-text-properties (match-beginning 0) (match-end 0)
(list 'chunked-encoding t
'face 'cursor
'invisible t))
(setq url-http-chunked-length
(string-to-number (buffer-substring (match-beginning 1)
(match-end 1))
16)
url-http-chunked-counter (1+ url-http-chunked-counter)
url-http-chunked-start (set-marker
(or url-http-chunked-start
(make-marker))
(match-end 0)))
(delete-region (match-beginning 0) (match-end 0))
(url-http-debug "Saw start of chunk %d (length=%d, start=%d"
url-http-chunked-counter url-http-chunked-length
(marker-position url-http-chunked-start))
;; add this line
(aichat--http-report-data)
(if (= 0 url-http-chunked-length)
(progn
;; Found the end of the document! Wheee!
(url-http-debug "Saw end of stream chunk!")
(setq read-next-chunk nil)
;; Every chunk, even the last 0-length one, is
;; terminated by CRLF. Skip it.
(if (not (looking-at "\r?\n"))
(progn
(url-http-debug
"Spinning for the terminator of last chunk...")
(setq url-http-chunked-last-crlf-missing
(point)))
(url-http-debug "Removing terminator of last chunk")
(delete-region (match-beginning 0) (match-end 0))
(when (re-search-forward "^\r?\n" nil t)
(url-http-debug "Saw end of trailers..."))
(when (url-http-parse-headers)
(url-http-activate-callback))))))))))))
(defun aichat--url-http-wait-for-headers-change-function (_st nd _length)
;; This will wait for the headers to arrive and then splice in the
;; next appropriate after-change-function, etc.
(url-http-debug "url-http-wait-for-headers-change-function (%s)"
(buffer-name))
(let ((end-of-headers nil)
(old-http nil)
(process-buffer (current-buffer))
;; (content-length nil)
)
(when (not (bobp))
(goto-char (point-min))
(if (and (looking-at ".*\n") ; have one line at least
(not (looking-at "^HTTP/[1-9]\\.[0-9]")))
;; Not HTTP/x.y data, must be 0.9
;; God, I wish this could die.
(setq end-of-headers t
url-http-end-of-headers 0
old-http t)
;; Blank line at end of headers.
(when (re-search-forward "^\r?\n" nil t)
(backward-char 1)
;; Saw the end of the headers
(url-http-debug "Saw end of headers... (%s)" (buffer-name))
(setq url-http-end-of-headers (set-marker (make-marker)
(point))
end-of-headers t)
(setq nd (- nd (url-http-clean-headers)))))
(if (not end-of-headers)
;; Haven't seen the end of the headers yet, need to wait
;; for more data to arrive.
nil
(unless old-http
(url-http-parse-response)
(mail-narrow-to-head)
(setq url-http-transfer-encoding (mail-fetch-field
"transfer-encoding")
url-http-content-type (mail-fetch-field "content-type"))
(if (mail-fetch-field "content-length")
(setq url-http-content-length
(string-to-number (mail-fetch-field "content-length"))))
(widen))
(when url-http-transfer-encoding
(setq url-http-transfer-encoding
(downcase url-http-transfer-encoding)))
(cond
((null url-http-response-status)
;; We got back a headerless malformed response from the
;; server.
(url-http-activate-callback))
((memq url-http-response-status '(204 205))
(url-http-debug "%d response must have headers only (%s)."
url-http-response-status (buffer-name))
(when (url-http-parse-headers)
(url-http-activate-callback)))
((string= "HEAD" url-http-method)
;; A HEAD request is _ALWAYS_ terminated by the header
;; information, regardless of any entity headers,
;; according to section 4.4 of the HTTP/1.1 draft.
(url-http-debug "HEAD request must have headers only (%s)."
(buffer-name))
(when (url-http-parse-headers)
(url-http-activate-callback)))
((string= "CONNECT" url-http-method)
;; A CONNECT request is finished, but we cannot stick this
;; back on the free connection list
(url-http-debug "CONNECT request must have headers only.")
(when (url-http-parse-headers)
(url-http-activate-callback)))
((equal url-http-response-status 304)
;; Only allowed to have a header section. We have to handle
;; this here instead of in url-http-parse-headers because if
;; you have a cached copy of something without a known
;; content-length, and try to retrieve it from the cache, we'd
;; fall into the 'being dumb' section and wait for the
;; connection to terminate, which means we'd wait for 10
;; seconds for the keep-alives to time out on some servers.
(when (url-http-parse-headers)
(url-http-activate-callback)))
(old-http
;; HTTP/0.9 always signaled end-of-connection by closing the
;; connection.
(url-http-debug
"Saw HTTP/0.9 response, connection closed means end of document.")
(setq url-http-after-change-function
#'url-http-simple-after-change-function))
((equal url-http-transfer-encoding "chunked")
(url-http-debug "Saw chunked encoding.")
(setq url-http-after-change-function
#'aichat--url-http-chunked-encoding-after-change-function)
(when (> nd url-http-end-of-headers)
(url-http-debug
"Calling initial chunked-encoding for extra data at end of headers")
(aichat--url-http-chunked-encoding-after-change-function
(marker-position url-http-end-of-headers) nd
(- nd url-http-end-of-headers))))
((integerp url-http-content-length)
(url-http-debug
"Got a content-length, being smart about document end.")
(setq url-http-after-change-function
#'aichat--url-http-content-length-after-change-function)
(cond
((= 0 url-http-content-length)
;; We got a NULL body! Activate the callback
;; immediately!
(url-http-debug
"Got 0-length content-length, activating callback immediately.")
(when (url-http-parse-headers)
(url-http-activate-callback)))
((> nd url-http-end-of-headers)
;; Have some leftover data
(url-http-debug "Calling initial content-length for extra data at end of headers")
(aichat--url-http-content-length-after-change-function
(marker-position url-http-end-of-headers)
nd
(- nd url-http-end-of-headers)))
(t
nil)))
(t
(url-http-debug "No content-length, being dumb.")
(setq url-http-after-change-function
#'url-http-simple-after-change-function)))))
;; We are still at the beginning of the buffer... must just be
;; waiting for a response.
(url-http-debug "Spinning waiting for headers...")
(when (eq process-buffer (current-buffer))
(goto-char (point-max)))))
(defun aichat--url-https-proxy-after-change-function (_st _nd _length)
(let* ((process-buffer (current-buffer))
(proc (get-buffer-process process-buffer)))
(goto-char (point-min))
(when (re-search-forward "^\r?\n" nil t)
(backward-char 1)
;; Saw the end of the headers
(setq url-http-end-of-headers (set-marker (make-marker) (point)))
(url-http-parse-response)
(cond
((null url-http-response-status)
;; We got back a headerless malformed response from the
;; server.
(url-http-activate-callback)
(error "Malformed response from proxy, fail!"))
((= url-http-response-status 200)
(if (gnutls-available-p)
(condition-case e
(let ((tls-connection (gnutls-negotiate
:process proc
:hostname (puny-encode-domain (url-host url-current-object))
:verify-error nil)))
;; check certificate validity
(setq tls-connection
(nsm-verify-connection tls-connection
(puny-encode-domain (url-host url-current-object))
(url-port url-current-object)))
(with-current-buffer process-buffer (erase-buffer))
(set-process-buffer tls-connection process-buffer)
(setq url-http-after-change-function
#'aichat--url-http-wait-for-headers-change-function)
(set-process-filter tls-connection 'url-http-generic-filter)
(process-send-string tls-connection
(aichat--url-http-create-request)))
(gnutls-error
(url-http-activate-callback)
(error "gnutls-error: %s" e))
(error
(url-http-activate-callback)
(error "Error: %s" e)))
(error "Error: gnutls support needed!")))
(t
(url-http-debug "error response: %d" url-http-response-status)
(url-http-activate-callback))))))
(defun aichat--url-https-proxy-connect (connection)
(setq url-http-after-change-function #'aichat--url-https-proxy-after-change-function)
(process-send-string
connection
(format
(concat "CONNECT %s:%d HTTP/1.1\r\n"
"Host: %s\r\n"
(let ((proxy-auth (let ((url-basic-auth-storage
'url-http-proxy-basic-auth-storage))
(url-get-authentication url-http-proxy nil
'any nil))))
(and proxy-auth
(concat "Proxy-Authorization: " proxy-auth "\r\n")))
"\r\n")
(puny-encode-domain (url-host url-current-object))
(or (url-port url-current-object)
url-https-default-port)
(puny-encode-domain (url-host url-current-object)))))
(defun aichat--url-http-async-sentinel (proc why)
;; We are performing an asynchronous connection, and a status change
;; has occurred.
(when (buffer-name (process-buffer proc))
(with-current-buffer (process-buffer proc)
(cond
(url-http-connection-opened
(setq url-http-no-retry t)
(url-http-end-of-document-sentinel proc why))
((string= (substring why 0 4) "open")
(setq url-http-connection-opened t)
(if (and url-http-proxy (string= "https" (url-type url-current-object)))
(aichat--url-https-proxy-connect proc)
(condition-case error
(process-send-string proc (aichat--url-http-create-request))
(file-error
(setq url-http-connection-opened nil)
(message "HTTP error: %s" error)))))
(t
(setf (car url-callback-arguments)
(nconc (list :error (list 'error 'connection-failed why
:host (url-host (or url-http-proxy url-current-object))
:service (url-port (or url-http-proxy url-current-object))))
(car url-callback-arguments)))
(url-http-activate-callback))))))
(defun aichat--url-interactive-p ()
"Non-nil when the current request is from an interactive context."
(not (or url-request-noninteractive
(bound-and-true-p url-http-noninteractive))))
(defconst url-aichat--http-default-port url-http-default-port)
(defconst url-aichat--http-asynchronous-p url-http-asynchronous-p)
(defalias 'url-aichat--http-expand-file-name #'url-http-expand-file-name)
(defalias 'url-aichat--http-file-exists-p #'url-http-file-exists-p)
(defalias 'url-aichat--http-file-readable-p #'url-http-file-readable-p)
(defalias 'url-aichat--http-file-attributes #'url-http-file-attributes)
(defun url-aichat--http (url callback cbargs &optional retry-buffer gateway-method)
"Retrieve URL via HTTP asynchronously.
URL must be a parsed URL. See `url-generic-parse-url' for details.
When retrieval is completed, execute the function CALLBACK,
passing it an updated value of CBARGS as arguments. The first
element in CBARGS should be a plist describing what has happened
so far during the request, as described in the docstring of
`url-retrieve' (if in doubt, specify nil). The current buffer
when CALLBACK is executed is the retrieval buffer.
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
previous `url-http' call, which is being re-attempted.
Optional arg GATEWAY-METHOD specifies the gateway to be used,
overriding the value of `url-gateway-method'.
The return value of this function is the retrieval buffer."
(cl-check-type url url "Need a pre-parsed URL.")
(setf (url-type url) (cadr (split-string (url-type url) "--")))
(let* (;; (host (url-host (or url-using-proxy url)))
;; (port (url-port (or url-using-proxy url)))
(nsm-noninteractive (not (aichat--url-interactive-p)))
;; The following binding is needed in url-open-stream, which
;; is called from url-http-find-free-connection.
(url-current-object url)
(connection (url-http-find-free-connection (url-host url)
(url-port url)
gateway-method))
(mime-accept-string url-mime-accept-string)
(buffer (or retry-buffer
(generate-new-buffer
(format " *http %s:%d*" (url-host url) (url-port url)))))
(referer (url-http--encode-string (url-http--get-referer url))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
(kill-buffer buffer)
(setq buffer nil)
(error "Could not create connection to %s:%d" (url-host url)
(url-port url)))
(with-current-buffer buffer
(mm-disable-multibyte)
(setq url-current-object url
mode-line-format "%b [%s]")
(dolist (var '(url-http-end-of-headers
url-http-content-type
url-http-content-length
url-http-transfer-encoding
url-http-after-change-function
url-http-response-version
url-http-response-status
url-http-chunked-last-crlf-missing
url-http-chunked-length
url-http-chunked-counter
url-http-chunked-start
url-callback-function
url-callback-arguments
url-show-status
url-http-process
url-http-method
url-http-extra-headers
url-http-noninteractive
url-http-data
url-http-target-url
url-http-no-retry
url-http-connection-opened
url-mime-accept-string
url-http-proxy
url-http-referer))
(set (make-local-variable var) nil))
(setq url-http-method (or url-request-method "GET")
url-http-extra-headers url-request-extra-headers
url-http-noninteractive url-request-noninteractive
url-http-data url-request-data
url-http-process connection
url-http-chunked-last-crlf-missing nil