sj3v2-socket.scm | searchcode

/scm/sj3v2-socket.scm

https://bitbucket.org/ohac/uim
Scheme | 443 lines | 362 code | 40 blank | 41 comment | 0 complexity | b43f6a4270deb13b354b51c35682e1c5 MD5 | raw file
Possible License(s): BSD-3-Clause, LGPL-2.1

;;; sj3v2-socket.scm: SJ3 protocol version 2 for uim.
;;;
;;; Copyright (c) 2009- uim Project http://code.google.com/p/uim/
;;;
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; 1. Redistributions of source code must retain the above copyright
;;;    notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above copyright
;;;    notice, this list of conditions and the following disclaimer in the
;;;    documentation and/or other materials provided with the distribution.
;;; 3. Neither the name of authors nor the names of its contributors
;;;    may be used to endorse or promote products derived from this software
;;;    without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.
;;;;

(use srfi-1)
(require "util.scm")
(require "i18n.scm")
(require "socket.scm")
(require "lolevel.scm")
(require "process.scm") ;; getpid

;; sj3v2 protocol operators
(define $SJ3_CONNECT        1)
(define $SJ3_DISCONNECT     2)
(define $SJ3_OPENDICT       11)
(define $SJ3_CLOSEDICT      12)
(define $SJ3_OPENSTDY       21)
(define $SJ3_CLOSESTDY      22)
(define $SJ3_STDYSIZE       23)
(define $SJ3_STUDY          61)
(define $SJ3_MAKEDICT       81)
(define $SJ3_MAKESTDY       82)
(define $SJ3_MAKEDIR        83)
(define $SJ3_ACCESS         84)
(define $SJ3_PH2KNJ_EUC     111)
(define $SJ3_CL2KNJ_ALL_EUC 115)
(define $SJ3_CL2KNJ_CNT_EUC 116)
(define $SJ3_CLSTUDY_EUC    117)

(define sj3-lib-error-str-alist
  '((-1  . (N_ "Internal server error."))    ;; SJ3_InternalError
    (0   . (N_ "No error."))                 ;; SJ3_NormalEnd
    (1   . (N_ "Serverdown."))               ;; SJ3_ServerDown
    (2   . (N_ "Cannot open socket."))       ;; SJ3_OpenSocket
    (3   . (N_ "Cannot connect socket."))    ;; SJ3_ConnectSocket
    (4   . (N_ "Unknown hostname."))         ;; SJ3_GetHostByName
    (5   . (N_ "Not opened."))               ;; SJ3_NotOpened
    (6   . (N_ "Not enough memory."))        ;; SJ3_NotEnoughMemory
    (7   . (N_ "Illegal command."))          ;; SJ3_IllegalCommand
    (11  . (N_ "Different version."))        ;; SJ3_DifferentVersion
    (12  . (N_ "No host name."))             ;; SJ3_NoHostName
    (13  . (N_ "No user name."))             ;; SJ3_NoUserName
    (14  . (N_ "User not allowd."))          ;; SJ3_NotAllowedUser
    (15  . (N_ "Already connected."))        ;; SJ3_AlreadyConnected
    (16  . (N_ "Not connected."))            ;; SJ3_NotConnected
    (21  . (N_ "Too long parameter."))       ;; SJ3_TooLongParameter
    (22  . (N_ "Illegal parameter."))        ;; SJ3_IllegalParameter
    (31  . (N_ "Bad dictionary ID."))        ;; SJ3_BadDictID
    (32  . (N_ "Illegal dictionary file."))  ;; SJ3_IllegalDictFile
    (33  . (N_ "Illegal study file."))       ;; SJ3_IllegalStdyFile
    (34  . (N_ "Incorrect password."))       ;; SJ3_IncorrectPasswd
    (35  . (N_ "File not exist."))           ;; SJ3_FileNotExist
    (36  . (N_ "Cannot access file."))       ;; SJ3_CannotAccessFile
    (37  . (N_ "Cannot open file."))         ;; SJ3_CannotOpenFile
    (38  . (N_ "Cannot create file."))       ;; SJ3_CannotCreateFile
    (39  . (N_ "File read error."))          ;; SJ3_FileReadError
    (40  . (N_ "File write error."))         ;; SJ3_FileWriteError
    (41  . (N_ "File seek error."))          ;; SJ3_FileSeekError
    (51  . (N_ "Study already opened."))     ;; SJ3_StdyAlreadyOpened
    (52  . (N_ "Study file not opened."))    ;; SJ3_StdyFileNotOpened
    (53  . (N_ "Too small study area."))     ;; SJ3_TooSmallStdyArea
    (61  . (N_ "Locked by other."))          ;; SJ3_LockedByOther
    (62  . (N_ "Not locked."))               ;; SJ3_NotLocked
    (71  . (N_ "No such dictionary."))       ;; SJ3_NoSuchDict
    (72  . (N_ "Dictionary is read only."))  ;; SJ3_ReadOnlyDict
    (73  . (N_ "Dictionary is locked."))     ;; SJ3_DictLocked
    (74  . (N_ "Yomi string is bad."))       ;; SJ3_BadYomiString
    (75  . (N_ "Kanji string is bad."))      ;; SJ3_BadKanjiString
    (76  . (N_ "Hinshi code is bad."))       ;; SJ3_BadHinsiCode
    (81  . (N_ "Add dictionary failed."))    ;; SJ3_AddDictFailed
    (82  . (N_ "Word is already exist."))    ;; SJ3_AlreadyExistWord
    (83  . (N_ "No more douon word."))       ;; SJ3_NoMoreDouonWord
    (84  . (N_ "No more user dictionary."))  ;; SJ3_NoMoreUserDict
    (85  . (N_ "No more index block"))       ;; SJ3_NoMoreIndexBlock
    (91  . (N_ "Delete dictionary failed.")) ;; SJ3_DelDictFailed
    (92  . (N_ "No such word."))             ;; SJ3_NoSuchWord
    (101 . (N_ "Directory already exist."))  ;; SJ3_DirAlreadyExist
    (102 . (N_ "Cannot create directory."))  ;; SJ3_CannotCreateDir
    (111 . (N_ "No more dictionary data."))  ;; SJ3_NoMoreDictData
    (121 . (N_ "User connected."))           ;; SJ3_UserConnected
    (131 . (N_ "Too long password."))        ;; SJ3_TooLongPasswd
    (132 . (N_ "Too long comment."))         ;; SJ3_TooLongComment
    (133 . (N_ "Cannot code convert."))))    ;; SJ3_CannotCodeConvert


(define sj3-protocol-version 2)

;; helper functions
(define (sj3-lib-get-string-with-terminate socket)
  (let loop ((c (file-read socket 1))
             (rest '()))
    (cond ((eof-object? c)
           (uim-notify-fatal (N_ "unexpected terminate string."))
           "")
          ((eq? (car c) #\nul)
           (file-buf->string (reverse rest)))
          (else
           (loop (file-read socket 1) (cons (car c) rest))))))


;;
;; sj3 protocol api
;;
(define (sj3-lib-connect socket user)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 u32 s8 s8 s8)
                            $SJ3_CONNECT sj3-protocol-version
                            "unix" user (format "~a.uim-sj3" (current-process-id)))))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (= -2 result))))

(define (sj3-lib-disconnect socket)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32) $SJ3_DISCONNECT)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (= 0 result))))

(define (sj3-lib-opendict socket dictionary-name passwd)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8 s8) $SJ3_OPENDICT
                            dictionary-name passwd)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (and (= result 0)
          (call-with-u8list-unpack
           '(u32) (string-buf->u8list (file-read socket 4))
           (lambda (result)
             result))))))

(define (sj3-lib-closedict socket dict-id)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 u32) $SJ3_CLOSEDICT dict-id)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (= 0 result))))

(define (sj3-lib-openstdy socket stdy-name)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8 s8) $SJ3_OPENSTDY stdy-name "")))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     result)))

(define (sj3-lib-closestdy socket)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32) $SJ3_CLOSESTDY)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     result)))

(define (sj3-lib-stdy-size socket)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32) $SJ3_STDYSIZE)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (and (= result 0)
          (call-with-u8list-unpack
           '(u32) (string-buf->u8list (file-read socket 4))
           (lambda (result)
             result))))))

(define (sj3-lib-study socket stdy)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 u8list) $SJ3_STUDY stdy)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     result)))

(define (sj3-lib-makedict socket dictionary-name)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8 u32 u32 u32) $SJ3_MAKEDICT
                            dictionary-name
                            2048  ; Index length
                            2048  ; Length
                            256   ; Number
                            )))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (= 0 result))))

(define (sj3-lib-makestdy socket stdy-name)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8 u32 u32 u32) $SJ3_MAKESTDY
                            stdy-name
                            2048  ; Number
                            1     ; Step
                            2048  ; Length
                            )))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (= 0 result))))

(define (sj3-lib-makedir socket directory-name)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8) $SJ3_MAKEDIR directory-name)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     result)))

(define (sj3-lib-access? socket directory-name mode)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8 u32) $SJ3_ACCESS
                            directory-name
                            mode)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (= 0 result))))

(define (sj3-lib-ph2knj-euc socket stdy-size yomi)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8) $SJ3_PH2KNJ_EUC yomi)))
  (call-with-u8list-unpack
   '(u32 u32) (string-buf->u8list (file-read socket 8))
   (lambda (result yomi-length)
     (and (= result 0)
          (let loop ((yomi-len (cons (car (string-buf->u8list (file-read socket 1)))
                                     '()))
                     (rest-stdy '())
                     (rest-kouho '()))
            (if (<= (car yomi-len) 0)
                (values (reverse yomi-len) (reverse rest-stdy) (reverse rest-kouho))
                (let* ((new-stdy (string-buf->u8list (file-read socket stdy-size)))
                       (new-kouho (sj3-lib-get-string-with-terminate socket)))
                  (loop (cons (car (string-buf->u8list (file-read socket 1)))
                              yomi-len)
                        (cons new-stdy rest-stdy)
                        (cons new-kouho rest-kouho)))))))))

(define (sj3-lib-cl2knj-all-euc socket stdy-size len yomi)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 u32 s8) $SJ3_CL2KNJ_ALL_EUC len yomi)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (and (= result 0)
          (let loop ((yomi-len
                      (cons (u8list->u32 (string-buf->u8list (file-read socket 4)))
                            '()))
                     (rest-stdy '())
                     (rest-kouho '()))
            (if (<= (car yomi-len) 0)
                (values (reverse yomi-len) (reverse rest-stdy) (reverse rest-kouho))
                (let* ((new-stdy (string-buf->u8list (file-read socket stdy-size)))
                       (new-kouho (sj3-lib-get-string-with-terminate socket)))
                  (loop (cons (u8list->u32 (string-buf->u8list (file-read socket 4)))
                              yomi-len)
                        (cons new-stdy rest-stdy)
                        (cons new-kouho rest-kouho)))))))))

(define (sj3-lib-cl2knj-cnt-euc socket stdy-size len yomi)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 u32 s8) $SJ3_CL2KNJ_CNT_EUC len yomi)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     (and (= result 0)
          (call-with-u8list-unpack
           '(u32) (string-buf->u8list (file-read socket 4))
           (lambda (result)
             result))))))

(define (sj3-lib-clstudy-euc socket yomi1 yomi2 stdy)
  (file-write socket
              (u8list->string-buf
               (u8list-pack '(u32 s8 s8 u8list) $SJ3_CLSTUDY_EUC
                            yomi1 yomi2 stdy)))
  (call-with-u8list-unpack
   '(u32) (string-buf->u8list (file-read socket 4))
   (lambda (result)
     result)))


;;
;; helper functions
;;
(define (sj3-lib-mkdir-p socket path)
  (let ((entries (string-split path "/")))
    (fold (lambda (acc rest)
            (let ((new-path (if (string=? rest "")
                                acc
                                (string-append rest "/" acc))))
              (if (not (sj3-lib-access? socket acc 0))
                  (sj3-lib-makedir socket new-path))
              new-path))
          ""
          entries)))

(define (sj3-lib-split-yomi yomi yomi-length-list)
  (let loop ((yomi yomi)
             (yomi-length-list yomi-length-list)
             (rest '()))
    (if (= (car yomi-length-list) 0)
        (reverse rest)
        (loop (substring yomi (car yomi-length-list) (string-length yomi))
              (cdr yomi-length-list)
              (cons (substring yomi 0 (car yomi-length-list)) rest)))))


;;
;; sj3lib compatible functions
;;

(define *sj3-lib-socket* #f)
(define *sj3-lib-stdy-size* 20)
(define *sj3-lib-main-dict* #f)
(define *sj3-lib-user-dict* #f)

(define (sj3-lib-get-private-path user-name)
  (format "user/~a" user-name))
(define (sj3-lib-get-private-dicionary-name user-name)
  (format "~a/private.dic" (sj3-lib-get-private-path user-name)))
(define (sj3-lib-get-private-study-name user-name)
  (format "~a/study.dat" (sj3-lib-get-private-path user-name)))

(define (sj3-lib-open-with-server server)
  (let ((server-name (if (equal? server "")
                         "localhost")))
    (if sj3-use-remote-server?
        (tcp-connect server-name 3086)
        (unix-domain-socket-connect sj3-unix-domain-socket-path))))

(define (sj3-lib-open server user-name)
  (set! *sj3-lib-socket* (sj3-lib-open-with-server server))
  (if *sj3-lib-socket*
      (begin
        (sj3-lib-connect *sj3-lib-socket* user-name)
        (set! *sj3-lib-main-dict* (sj3-lib-opendict *sj3-lib-socket* "sj3main.dic" ""))
        (if (not (sj3-lib-access? *sj3-lib-socket* (sj3-lib-get-private-path user-name) 0))
            (begin
              (sj3-lib-mkdir-p *sj3-lib-socket* (sj3-lib-get-private-path user-name))
              (sj3-lib-makedict *sj3-lib-socket* (sj3-lib-get-private-dicionary-name user-name))
              (uim-notify-info (N_ "SJ3: create new dictionary"))))
        (if (not (sj3-lib-access? *sj3-lib-socket* (sj3-lib-get-private-study-name user-name) 0))
            (sj3-lib-makestdy *sj3-lib-socket* (sj3-lib-get-private-study-name user-name)))
        (set! *sj3-lib-user-dict*
              (sj3-lib-opendict *sj3-lib-socket* (sj3-lib-get-private-dicionary-name user-name) ""))
        (sj3-lib-openstdy *sj3-lib-socket* (sj3-lib-get-private-study-name user-name))
        (set! *sj3-lib-stdy-size* (sj3-lib-stdy-size *sj3-lib-socket*))))
  *sj3-lib-socket*)

(define (sj3-lib-close)
  (if *sj3-lib-socket*
      (begin
        (sj3-lib-closestdy *sj3-lib-socket*)
        (sj3-lib-closedict *sj3-lib-socket* *sj3-lib-user-dict*)
        (sj3-lib-closedict *sj3-lib-socket* *sj3-lib-main-dict*)
        (sj3-lib-disconnect *sj3-lib-socket*)
        (file-close *sj3-lib-socket*))))

(define (sj3-lib-getkan yomi)
  (receive (yomi-len stdy cands)
      (sj3-lib-ph2knj-euc *sj3-lib-socket* *sj3-lib-stdy-size* yomi)
    (cons (apply string-append cands)
          (zip (sj3-lib-split-yomi yomi yomi-len)
               cands
               stdy))))

(define (sj3-lib-douoncnt yomi)
  (sj3-lib-cl2knj-cnt-euc *sj3-lib-socket* *sj3-lib-stdy-size*
                          (length (string->list yomi)) ;; byte length
                          yomi))

(define (sj3-lib-getdouon yomi)
  (receive (yomi-len stdy cand)
      (sj3-lib-cl2knj-all-euc *sj3-lib-socket* *sj3-lib-stdy-size*
                              (length (string->list yomi)) ;; byte length
                              yomi)
    (zip cand stdy)))

(define (sj3-lib-get-nth-douon yomi nth)
  (receive (yomi-len stdy cand)
      (sj3-lib-cl2knj-all-euc *sj3-lib-socket* *sj3-lib-stdy-size*
                              (length (string->list yomi)) ;; byte length
                              yomi)
    (list (list-ref cand nth)
          (list-ref stdy nth))))

(define (sj3-lib-gakusyuu stdy)
  (sj3-lib-study *sj3-lib-socket* stdy))

(define (sj3-lib-gakusyuu2 yomi1 yomi2 stdy)
  (let ((new-yomi1 (and yomi1 ""))
        (new-yomi2 (and yomi2 "")))
    (sj3-lib-clstudy-euc *sj3-lib-socket*
                         new-yomi1 new-yomi2
                         stdy)))