PageRenderTime 164ms CodeModel.GetById 2ms app.highlight 21ms RepoModel.GetById 129ms app.codeStats 0ms

/scm/sj3v2-socket.scm

https://bitbucket.org/ohac/uim
Lisp | 443 lines | 362 code | 40 blank | 41 comment | 0 complexity | b43f6a4270deb13b354b51c35682e1c5 MD5 | raw file
  1;;; sj3v2-socket.scm: SJ3 protocol version 2 for uim.
  2;;;
  3;;; Copyright (c) 2009- uim Project http://code.google.com/p/uim/
  4;;;
  5;;; All rights reserved.
  6;;;
  7;;; Redistribution and use in source and binary forms, with or without
  8;;; modification, are permitted provided that the following conditions
  9;;; are met:
 10;;; 1. Redistributions of source code must retain the above copyright
 11;;;    notice, this list of conditions and the following disclaimer.
 12;;; 2. Redistributions in binary form must reproduce the above copyright
 13;;;    notice, this list of conditions and the following disclaimer in the
 14;;;    documentation and/or other materials provided with the distribution.
 15;;; 3. Neither the name of authors nor the names of its contributors
 16;;;    may be used to endorse or promote products derived from this software
 17;;;    without specific prior written permission.
 18;;;
 19;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
 20;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 21;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 22;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
 23;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 24;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 25;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 26;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 27;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 28;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 29;;; SUCH DAMAGE.
 30;;;;
 31
 32(use srfi-1)
 33(require "util.scm")
 34(require "i18n.scm")
 35(require "socket.scm")
 36(require "lolevel.scm")
 37(require "process.scm") ;; getpid
 38
 39;; sj3v2 protocol operators
 40(define $SJ3_CONNECT        1)
 41(define $SJ3_DISCONNECT     2)
 42(define $SJ3_OPENDICT       11)
 43(define $SJ3_CLOSEDICT      12)
 44(define $SJ3_OPENSTDY       21)
 45(define $SJ3_CLOSESTDY      22)
 46(define $SJ3_STDYSIZE       23)
 47(define $SJ3_STUDY          61)
 48(define $SJ3_MAKEDICT       81)
 49(define $SJ3_MAKESTDY       82)
 50(define $SJ3_MAKEDIR        83)
 51(define $SJ3_ACCESS         84)
 52(define $SJ3_PH2KNJ_EUC     111)
 53(define $SJ3_CL2KNJ_ALL_EUC 115)
 54(define $SJ3_CL2KNJ_CNT_EUC 116)
 55(define $SJ3_CLSTUDY_EUC    117)
 56
 57(define sj3-lib-error-str-alist
 58  '((-1  . (N_ "Internal server error."))    ;; SJ3_InternalError
 59    (0   . (N_ "No error."))                 ;; SJ3_NormalEnd
 60    (1   . (N_ "Serverdown."))               ;; SJ3_ServerDown
 61    (2   . (N_ "Cannot open socket."))       ;; SJ3_OpenSocket
 62    (3   . (N_ "Cannot connect socket."))    ;; SJ3_ConnectSocket
 63    (4   . (N_ "Unknown hostname."))         ;; SJ3_GetHostByName
 64    (5   . (N_ "Not opened."))               ;; SJ3_NotOpened
 65    (6   . (N_ "Not enough memory."))        ;; SJ3_NotEnoughMemory
 66    (7   . (N_ "Illegal command."))          ;; SJ3_IllegalCommand
 67    (11  . (N_ "Different version."))        ;; SJ3_DifferentVersion
 68    (12  . (N_ "No host name."))             ;; SJ3_NoHostName
 69    (13  . (N_ "No user name."))             ;; SJ3_NoUserName
 70    (14  . (N_ "User not allowd."))          ;; SJ3_NotAllowedUser
 71    (15  . (N_ "Already connected."))        ;; SJ3_AlreadyConnected
 72    (16  . (N_ "Not connected."))            ;; SJ3_NotConnected
 73    (21  . (N_ "Too long parameter."))       ;; SJ3_TooLongParameter
 74    (22  . (N_ "Illegal parameter."))        ;; SJ3_IllegalParameter
 75    (31  . (N_ "Bad dictionary ID."))        ;; SJ3_BadDictID
 76    (32  . (N_ "Illegal dictionary file."))  ;; SJ3_IllegalDictFile
 77    (33  . (N_ "Illegal study file."))       ;; SJ3_IllegalStdyFile
 78    (34  . (N_ "Incorrect password."))       ;; SJ3_IncorrectPasswd
 79    (35  . (N_ "File not exist."))           ;; SJ3_FileNotExist
 80    (36  . (N_ "Cannot access file."))       ;; SJ3_CannotAccessFile
 81    (37  . (N_ "Cannot open file."))         ;; SJ3_CannotOpenFile
 82    (38  . (N_ "Cannot create file."))       ;; SJ3_CannotCreateFile
 83    (39  . (N_ "File read error."))          ;; SJ3_FileReadError
 84    (40  . (N_ "File write error."))         ;; SJ3_FileWriteError
 85    (41  . (N_ "File seek error."))          ;; SJ3_FileSeekError
 86    (51  . (N_ "Study already opened."))     ;; SJ3_StdyAlreadyOpened
 87    (52  . (N_ "Study file not opened."))    ;; SJ3_StdyFileNotOpened
 88    (53  . (N_ "Too small study area."))     ;; SJ3_TooSmallStdyArea
 89    (61  . (N_ "Locked by other."))          ;; SJ3_LockedByOther
 90    (62  . (N_ "Not locked."))               ;; SJ3_NotLocked
 91    (71  . (N_ "No such dictionary."))       ;; SJ3_NoSuchDict
 92    (72  . (N_ "Dictionary is read only."))  ;; SJ3_ReadOnlyDict
 93    (73  . (N_ "Dictionary is locked."))     ;; SJ3_DictLocked
 94    (74  . (N_ "Yomi string is bad."))       ;; SJ3_BadYomiString
 95    (75  . (N_ "Kanji string is bad."))      ;; SJ3_BadKanjiString
 96    (76  . (N_ "Hinshi code is bad."))       ;; SJ3_BadHinsiCode
 97    (81  . (N_ "Add dictionary failed."))    ;; SJ3_AddDictFailed
 98    (82  . (N_ "Word is already exist."))    ;; SJ3_AlreadyExistWord
 99    (83  . (N_ "No more douon word."))       ;; SJ3_NoMoreDouonWord
100    (84  . (N_ "No more user dictionary."))  ;; SJ3_NoMoreUserDict
101    (85  . (N_ "No more index block"))       ;; SJ3_NoMoreIndexBlock
102    (91  . (N_ "Delete dictionary failed.")) ;; SJ3_DelDictFailed
103    (92  . (N_ "No such word."))             ;; SJ3_NoSuchWord
104    (101 . (N_ "Directory already exist."))  ;; SJ3_DirAlreadyExist
105    (102 . (N_ "Cannot create directory."))  ;; SJ3_CannotCreateDir
106    (111 . (N_ "No more dictionary data."))  ;; SJ3_NoMoreDictData
107    (121 . (N_ "User connected."))           ;; SJ3_UserConnected
108    (131 . (N_ "Too long password."))        ;; SJ3_TooLongPasswd
109    (132 . (N_ "Too long comment."))         ;; SJ3_TooLongComment
110    (133 . (N_ "Cannot code convert."))))    ;; SJ3_CannotCodeConvert
111
112
113(define sj3-protocol-version 2)
114
115;; helper functions
116(define (sj3-lib-get-string-with-terminate socket)
117  (let loop ((c (file-read socket 1))
118             (rest '()))
119    (cond ((eof-object? c)
120           (uim-notify-fatal (N_ "unexpected terminate string."))
121           "")
122          ((eq? (car c) #\nul)
123           (file-buf->string (reverse rest)))
124          (else
125           (loop (file-read socket 1) (cons (car c) rest))))))
126
127
128;;
129;; sj3 protocol api
130;;
131(define (sj3-lib-connect socket user)
132  (file-write socket
133              (u8list->string-buf
134               (u8list-pack '(u32 u32 s8 s8 s8)
135                            $SJ3_CONNECT sj3-protocol-version
136                            "unix" user (format "~a.uim-sj3" (current-process-id)))))
137  (call-with-u8list-unpack
138   '(u32) (string-buf->u8list (file-read socket 4))
139   (lambda (result)
140     (= -2 result))))
141
142(define (sj3-lib-disconnect socket)
143  (file-write socket
144              (u8list->string-buf
145               (u8list-pack '(u32) $SJ3_DISCONNECT)))
146  (call-with-u8list-unpack
147   '(u32) (string-buf->u8list (file-read socket 4))
148   (lambda (result)
149     (= 0 result))))
150
151(define (sj3-lib-opendict socket dictionary-name passwd)
152  (file-write socket
153              (u8list->string-buf
154               (u8list-pack '(u32 s8 s8) $SJ3_OPENDICT
155                            dictionary-name passwd)))
156  (call-with-u8list-unpack
157   '(u32) (string-buf->u8list (file-read socket 4))
158   (lambda (result)
159     (and (= result 0)
160          (call-with-u8list-unpack
161           '(u32) (string-buf->u8list (file-read socket 4))
162           (lambda (result)
163             result))))))
164
165(define (sj3-lib-closedict socket dict-id)
166  (file-write socket
167              (u8list->string-buf
168               (u8list-pack '(u32 u32) $SJ3_CLOSEDICT dict-id)))
169  (call-with-u8list-unpack
170   '(u32) (string-buf->u8list (file-read socket 4))
171   (lambda (result)
172     (= 0 result))))
173
174(define (sj3-lib-openstdy socket stdy-name)
175  (file-write socket
176              (u8list->string-buf
177               (u8list-pack '(u32 s8 s8) $SJ3_OPENSTDY stdy-name "")))
178  (call-with-u8list-unpack
179   '(u32) (string-buf->u8list (file-read socket 4))
180   (lambda (result)
181     result)))
182
183(define (sj3-lib-closestdy socket)
184  (file-write socket
185              (u8list->string-buf
186               (u8list-pack '(u32) $SJ3_CLOSESTDY)))
187  (call-with-u8list-unpack
188   '(u32) (string-buf->u8list (file-read socket 4))
189   (lambda (result)
190     result)))
191
192(define (sj3-lib-stdy-size socket)
193  (file-write socket
194              (u8list->string-buf
195               (u8list-pack '(u32) $SJ3_STDYSIZE)))
196  (call-with-u8list-unpack
197   '(u32) (string-buf->u8list (file-read socket 4))
198   (lambda (result)
199     (and (= result 0)
200          (call-with-u8list-unpack
201           '(u32) (string-buf->u8list (file-read socket 4))
202           (lambda (result)
203             result))))))
204
205(define (sj3-lib-study socket stdy)
206  (file-write socket
207              (u8list->string-buf
208               (u8list-pack '(u32 u8list) $SJ3_STUDY stdy)))
209  (call-with-u8list-unpack
210   '(u32) (string-buf->u8list (file-read socket 4))
211   (lambda (result)
212     result)))
213
214(define (sj3-lib-makedict socket dictionary-name)
215  (file-write socket
216              (u8list->string-buf
217               (u8list-pack '(u32 s8 u32 u32 u32) $SJ3_MAKEDICT
218                            dictionary-name
219                            2048  ; Index length
220                            2048  ; Length
221                            256   ; Number
222                            )))
223  (call-with-u8list-unpack
224   '(u32) (string-buf->u8list (file-read socket 4))
225   (lambda (result)
226     (= 0 result))))
227
228(define (sj3-lib-makestdy socket stdy-name)
229  (file-write socket
230              (u8list->string-buf
231               (u8list-pack '(u32 s8 u32 u32 u32) $SJ3_MAKESTDY
232                            stdy-name
233                            2048  ; Number
234                            1     ; Step
235                            2048  ; Length
236                            )))
237  (call-with-u8list-unpack
238   '(u32) (string-buf->u8list (file-read socket 4))
239   (lambda (result)
240     (= 0 result))))
241
242(define (sj3-lib-makedir socket directory-name)
243  (file-write socket
244              (u8list->string-buf
245               (u8list-pack '(u32 s8) $SJ3_MAKEDIR directory-name)))
246  (call-with-u8list-unpack
247   '(u32) (string-buf->u8list (file-read socket 4))
248   (lambda (result)
249     result)))
250
251(define (sj3-lib-access? socket directory-name mode)
252  (file-write socket
253              (u8list->string-buf
254               (u8list-pack '(u32 s8 u32) $SJ3_ACCESS
255                            directory-name
256                            mode)))
257  (call-with-u8list-unpack
258   '(u32) (string-buf->u8list (file-read socket 4))
259   (lambda (result)
260     (= 0 result))))
261
262(define (sj3-lib-ph2knj-euc socket stdy-size yomi)
263  (file-write socket
264              (u8list->string-buf
265               (u8list-pack '(u32 s8) $SJ3_PH2KNJ_EUC yomi)))
266  (call-with-u8list-unpack
267   '(u32 u32) (string-buf->u8list (file-read socket 8))
268   (lambda (result yomi-length)
269     (and (= result 0)
270          (let loop ((yomi-len (cons (car (string-buf->u8list (file-read socket 1)))
271                                     '()))
272                     (rest-stdy '())
273                     (rest-kouho '()))
274            (if (<= (car yomi-len) 0)
275                (values (reverse yomi-len) (reverse rest-stdy) (reverse rest-kouho))
276                (let* ((new-stdy (string-buf->u8list (file-read socket stdy-size)))
277                       (new-kouho (sj3-lib-get-string-with-terminate socket)))
278                  (loop (cons (car (string-buf->u8list (file-read socket 1)))
279                              yomi-len)
280                        (cons new-stdy rest-stdy)
281                        (cons new-kouho rest-kouho)))))))))
282
283(define (sj3-lib-cl2knj-all-euc socket stdy-size len yomi)
284  (file-write socket
285              (u8list->string-buf
286               (u8list-pack '(u32 u32 s8) $SJ3_CL2KNJ_ALL_EUC len yomi)))
287  (call-with-u8list-unpack
288   '(u32) (string-buf->u8list (file-read socket 4))
289   (lambda (result)
290     (and (= result 0)
291          (let loop ((yomi-len
292                      (cons (u8list->u32 (string-buf->u8list (file-read socket 4)))
293                            '()))
294                     (rest-stdy '())
295                     (rest-kouho '()))
296            (if (<= (car yomi-len) 0)
297                (values (reverse yomi-len) (reverse rest-stdy) (reverse rest-kouho))
298                (let* ((new-stdy (string-buf->u8list (file-read socket stdy-size)))
299                       (new-kouho (sj3-lib-get-string-with-terminate socket)))
300                  (loop (cons (u8list->u32 (string-buf->u8list (file-read socket 4)))
301                              yomi-len)
302                        (cons new-stdy rest-stdy)
303                        (cons new-kouho rest-kouho)))))))))
304
305(define (sj3-lib-cl2knj-cnt-euc socket stdy-size len yomi)
306  (file-write socket
307              (u8list->string-buf
308               (u8list-pack '(u32 u32 s8) $SJ3_CL2KNJ_CNT_EUC len yomi)))
309  (call-with-u8list-unpack
310   '(u32) (string-buf->u8list (file-read socket 4))
311   (lambda (result)
312     (and (= result 0)
313          (call-with-u8list-unpack
314           '(u32) (string-buf->u8list (file-read socket 4))
315           (lambda (result)
316             result))))))
317
318(define (sj3-lib-clstudy-euc socket yomi1 yomi2 stdy)
319  (file-write socket
320              (u8list->string-buf
321               (u8list-pack '(u32 s8 s8 u8list) $SJ3_CLSTUDY_EUC
322                            yomi1 yomi2 stdy)))
323  (call-with-u8list-unpack
324   '(u32) (string-buf->u8list (file-read socket 4))
325   (lambda (result)
326     result)))
327
328
329;;
330;; helper functions
331;;
332(define (sj3-lib-mkdir-p socket path)
333  (let ((entries (string-split path "/")))
334    (fold (lambda (acc rest)
335            (let ((new-path (if (string=? rest "")
336                                acc
337                                (string-append rest "/" acc))))
338              (if (not (sj3-lib-access? socket acc 0))
339                  (sj3-lib-makedir socket new-path))
340              new-path))
341          ""
342          entries)))
343
344(define (sj3-lib-split-yomi yomi yomi-length-list)
345  (let loop ((yomi yomi)
346             (yomi-length-list yomi-length-list)
347             (rest '()))
348    (if (= (car yomi-length-list) 0)
349        (reverse rest)
350        (loop (substring yomi (car yomi-length-list) (string-length yomi))
351              (cdr yomi-length-list)
352              (cons (substring yomi 0 (car yomi-length-list)) rest)))))
353
354
355;;
356;; sj3lib compatible functions
357;;
358
359(define *sj3-lib-socket* #f)
360(define *sj3-lib-stdy-size* 20)
361(define *sj3-lib-main-dict* #f)
362(define *sj3-lib-user-dict* #f)
363
364(define (sj3-lib-get-private-path user-name)
365  (format "user/~a" user-name))
366(define (sj3-lib-get-private-dicionary-name user-name)
367  (format "~a/private.dic" (sj3-lib-get-private-path user-name)))
368(define (sj3-lib-get-private-study-name user-name)
369  (format "~a/study.dat" (sj3-lib-get-private-path user-name)))
370
371(define (sj3-lib-open-with-server server)
372  (let ((server-name (if (equal? server "")
373                         "localhost")))
374    (if sj3-use-remote-server?
375        (tcp-connect server-name 3086)
376        (unix-domain-socket-connect sj3-unix-domain-socket-path))))
377
378(define (sj3-lib-open server user-name)
379  (set! *sj3-lib-socket* (sj3-lib-open-with-server server))
380  (if *sj3-lib-socket*
381      (begin
382        (sj3-lib-connect *sj3-lib-socket* user-name)
383        (set! *sj3-lib-main-dict* (sj3-lib-opendict *sj3-lib-socket* "sj3main.dic" ""))
384        (if (not (sj3-lib-access? *sj3-lib-socket* (sj3-lib-get-private-path user-name) 0))
385            (begin
386              (sj3-lib-mkdir-p *sj3-lib-socket* (sj3-lib-get-private-path user-name))
387              (sj3-lib-makedict *sj3-lib-socket* (sj3-lib-get-private-dicionary-name user-name))
388              (uim-notify-info (N_ "SJ3: create new dictionary"))))
389        (if (not (sj3-lib-access? *sj3-lib-socket* (sj3-lib-get-private-study-name user-name) 0))
390            (sj3-lib-makestdy *sj3-lib-socket* (sj3-lib-get-private-study-name user-name)))
391        (set! *sj3-lib-user-dict*
392              (sj3-lib-opendict *sj3-lib-socket* (sj3-lib-get-private-dicionary-name user-name) ""))
393        (sj3-lib-openstdy *sj3-lib-socket* (sj3-lib-get-private-study-name user-name))
394        (set! *sj3-lib-stdy-size* (sj3-lib-stdy-size *sj3-lib-socket*))))
395  *sj3-lib-socket*)
396
397(define (sj3-lib-close)
398  (if *sj3-lib-socket*
399      (begin
400        (sj3-lib-closestdy *sj3-lib-socket*)
401        (sj3-lib-closedict *sj3-lib-socket* *sj3-lib-user-dict*)
402        (sj3-lib-closedict *sj3-lib-socket* *sj3-lib-main-dict*)
403        (sj3-lib-disconnect *sj3-lib-socket*)
404        (file-close *sj3-lib-socket*))))
405
406(define (sj3-lib-getkan yomi)
407  (receive (yomi-len stdy cands)
408      (sj3-lib-ph2knj-euc *sj3-lib-socket* *sj3-lib-stdy-size* yomi)
409    (cons (apply string-append cands)
410          (zip (sj3-lib-split-yomi yomi yomi-len)
411               cands
412               stdy))))
413
414(define (sj3-lib-douoncnt yomi)
415  (sj3-lib-cl2knj-cnt-euc *sj3-lib-socket* *sj3-lib-stdy-size*
416                          (length (string->list yomi)) ;; byte length
417                          yomi))
418
419(define (sj3-lib-getdouon yomi)
420  (receive (yomi-len stdy cand)
421      (sj3-lib-cl2knj-all-euc *sj3-lib-socket* *sj3-lib-stdy-size*
422                              (length (string->list yomi)) ;; byte length
423                              yomi)
424    (zip cand stdy)))
425
426(define (sj3-lib-get-nth-douon yomi nth)
427  (receive (yomi-len stdy cand)
428      (sj3-lib-cl2knj-all-euc *sj3-lib-socket* *sj3-lib-stdy-size*
429                              (length (string->list yomi)) ;; byte length
430                              yomi)
431    (list (list-ref cand nth)
432          (list-ref stdy nth))))
433
434(define (sj3-lib-gakusyuu stdy)
435  (sj3-lib-study *sj3-lib-socket* stdy))
436
437(define (sj3-lib-gakusyuu2 yomi1 yomi2 stdy)
438  (let ((new-yomi1 (and yomi1 ""))
439        (new-yomi2 (and yomi2 "")))
440    (sj3-lib-clstudy-euc *sj3-lib-socket*
441                         new-yomi1 new-yomi2
442                         stdy)))
443