sekka 0.8.0

data/README

@@ -0,0 +1,22 @@
+
+                                   Sekka (石火)
+
+Sekkaはモードレスなローマ字かな漢字変換エンジンです。SKKにインスパイアされています。
+
+1. 特徴
+
+  1) Emacsの上で動き、次のようなインタフェースを持ちます。
+     日本語変換モードというものはありません。(Emacsのマイナーモードで作成)
+     いつでも[Ctrl-J]キーで、カーソルキーの直前のローマ字が変換可能です。
+     例えば、Nihongo[Ctrl-J] で 「日本語」に変換します。
+
+  2) SKKの大文字小文字指定ルールが適用されます。
+     OkonaU => 行う            に変換される。(送り仮名あり)
+     okonaU => 行う            アルファベット中に大文字が1文字でもあれば漢字かな混じりとみなされる。
+     okonau => おこなう        (全て平仮名)に変換される。
+     Kanji  => 漢字,幹事       など、送り仮名なしの漢字に変換される
+
+  3) ローマ字綴りミスはあいまい検索により、適度に救済されます。
+     (Jaro-Winkler文字列類似度による検索)
+
+  4) ローマ字の表記ゆれ、AZIK等の特殊ローマ字にも標準で対応します。(通常ローマ字、AZICなどモード切替なしですべて対応可能)

data/bin/.gitignore

@@ -0,0 +1 @@
+/sekka-jisyo~

data/bin/sekka-jisyo

@@ -0,0 +1,98 @@
+#!/usr/bin/env ruby
+# -*- mode: nendo; syntax: scheme ; coding: utf-8 -*-
+require 'nendo'
+$LOAD_PATH.push( File.dirname(__FILE__) + "/../lib" )
+core = Nendo::Core.new()
+core.setArgv( ARGV )
+core.loadInitFile
+core.evalStr( <<";;END-OF-SCRIPT" )
+;;;
+;;; sekka-jisyo - Sekkaの辞書メンテナンスツール
+;;;  
+;;;   Copyright (c) 2010  Kiyoka Nishiyama  <kiyoka@sumibi.org>
+;;;   
+;;;   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 the 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
+;;;   OWNER 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.
+;;;  
+;;;  $Id: 
+;;;
+(use sekka.convert-jisyo)
+(use sekka.jisyo-db)
+
+(define (convert-skk-jisyo filename)
+  (let1 lines (with-open
+               filename
+               (lambda (f)
+                 (convert-skk-jisyo-f f)))
+    (for-each print lines)))
+
+
+(define (load-sekka-jisyo sekka-file target)
+  (with-open
+   sekka-file
+   (lambda (f)
+     (when (not (rxmatch #/.tch$/ target))
+       (set-kvs-type 'memcache))
+     (load-sekka-jisyo-f f target))))
+
+
+(define (dump-sekka-jisyo sekka-file)
+  (let1 f STDOUT
+    (dump-sekka-jisyo-f f (+ sekka-file ".tch"))))
+
+
+(define (display-help)
+  (print "Usage : ")
+  (print "  sekka-jisyo convert SKK-JISYO.L                        ... output SEKKA-JISYO to STDOUT")
+  (print "  sekka-jisyo load    SEKKA-JISYO.L  SEKKA-JISYO.L.tch   ... load   SEKKA-JISYO to DB(*.tch)")
+  (print "  sekka-jisyo dump    SEKKA-JISYO.L                      ... dump   DB(*.tch) to SEKKA-JISYO(STDOUT)"))
+
+
+(define (main argv)
+  (cond
+   ((= 0 (length argv))
+    (display-help))
+   (else
+    (let1 command (string->symbol (first argv))
+      (cond
+       ((eq? 'convert command)
+        (if (< (length argv) 2)
+            (display-help)
+            (convert-skk-jisyo (second argv))))
+       ((eq? 'load command)
+        (if (< (length argv) 3)
+            (display-help)
+            (load-sekka-jisyo (second argv) (third argv))))
+       ((eq? 'dump command)
+        (if (< (length argv) 2)
+            (display-help)
+            (dump-sekka-jisyo (second argv))))
+       (else
+        (errorf "Error: no such command [%s] \n" command )))))))
+
+(main *argv*)
+;;END-OF-SCRIPT

data/bin/sekka-server

@@ -0,0 +1,83 @@
+#!/usr/bin/env ruby
+# -*- coding: utf-8 -*-
+
+require 'digest/md5'
+require 'fileutils'
+require 'rack'
+require File.expand_path(File.dirname(__FILE__) + "/../lib/sekkaconfig")
+require File.expand_path(File.dirname(__FILE__) + "/../lib/sekka/sekkaversion")
+
+
+
+DICTDIR = File.expand_path( "~/.sekka-server" )
+DICTURL = "http://sumibi.org/sekka/dict/" + SekkaVersion.version
+
+TC_FILE = DICTDIR + "/SEKKA-JISYO.SMALL.tch"
+SUMFILE = DICTDIR + "/SEKKA-JISYO.SMALL.md5"
+TC_URL  = DICTURL + "/SEKKA-JISYO.SMALL.tch"
+SUMURL  = DICTURL + "/SEKKA-JISYO.SMALL.md5"
+
+TC_FILE_LIST = [ DICTDIR + "/SEKKA-JISYO.CUSTOM.tch",
+                 DICTDIR + "/SEKKA-JISYO.LARGE.tch",
+                 DICTDIR + "/SEKKA-JISYO.SMALL.tch" ]
+
+MEMCACHED = "localhost:11211"                # memcahced
+
+
+def main
+  if not File.directory?( DICTDIR )
+    Dir.mkdir( DICTDIR )
+    STDERR.printf( "Info: created directory [%s]\n", DICTDIR )
+  end
+
+  if not File.exist?( TC_FILE )
+    STDERR.printf( "Info: Downloading SEKKA-JISYO\n" )
+    # 辞書をダウンロードする
+    cmd = sprintf( "curl -o %s %s",    TC_FILE, TC_URL )
+    STDERR.printf( "Command : %s\n", cmd )
+    system( cmd )
+    cmd = sprintf( "curl -o %s %s",    SUMFILE, SUMURL )
+    STDERR.printf( "Command : %s\n", cmd )
+    system( cmd )
+
+    # チェックサムを確認する
+    downloadSum = ""
+    open( TC_FILE ) { |f|
+      dataBody = f.read
+      downloadSum = Digest::MD5.hexdigest( dataBody )
+    }
+    open( SUMFILE ) { |f|
+      correctSum = f.readline.chomp.split[0]
+      STDERR.printf( "   downloaded file's MD5 : %s\n", downloadSum )
+      STDERR.printf( "             correct MD5 : %s\n", correctSum   )
+      if downloadSum == correctSum
+        STDERR.printf( "Info:  downloaded file [%s] verify OK.\n", TC_FILE )
+      else
+        STDERR.printf( "Error: downloaded file [%s] verify NG.\n", TC_FILE )
+        File.unlink( TC_FILE )
+        exit( 1 )
+      end
+    }
+  end
+
+  # 辞書ディレクトリに存在している辞書ファイルリストを作る
+  list = TC_FILE_LIST.select { |name| File.exist?( name ) }
+
+  # 設定項目をConfigオブジェクトに代入
+  SekkaServer::Config.setup( list[0], MEMCACHED, 12929 )
+
+  # サーバースクリプトのrootディレクトリへ移動
+  FileUtils.cd(File.dirname(__FILE__) + "/../")
+
+  # サーバー起動
+  Rack::Server.start(
+                     :environment => "development",
+                     :pid         => nil,
+                     :Port        => SekkaServer::Config.listenPort,
+                     :Host        => "0.0.0.0",
+                     :AccessLog   => [],
+                     :config      => "./lib/sekka.ru"
+                     )
+end
+
+main()

data/emacs/http-cookies.el

@@ -0,0 +1,416 @@
+;;; http-cookies.el --- simple HTTP cookies implementation
+
+;; Copyright (C) 2004, David Hansen
+
+;; Author: David Hansen <david.hansen@physik.fu-berlin.de>
+;; Maintainer: David Hansen <david.hansen@physik.fu-berlin.de>
+;; Version: 1.0.0
+;; Keywords: hypermedia
+
+;; This file is not part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; Implementation of old netscape cookies (used by maybe all servers) and
+;; version 1 cookies.
+;;
+;; See http://www.faqs.org/rfcs/rfc2109.html and
+;; http://wp.netscape.com/newsref/std/cookie_spec.html
+
+;;; Change log:
+
+;;; TODO:
+
+;;    - whitelist
+;;    - blacklist
+;;    - reading from file, saving to file
+;;    - expire
+
+;;; Code:
+
+(require 'time-date)
+
+(defconst http-cookies-version "1.0.0")
+
+(defgroup http-emacs ()
+  "Simple HTTP client implementation in elisp.")
+
+(defcustom http-emacs-use-cookies nil
+  "Use cookies in the http-emacs package. *EXPERIMENTAL*"
+  :type 'boolean
+  :group 'http-emacs)
+
+(defcustom http-emacs-cookie-file "~/.emacs-cookies"
+  "*File where to store the cookies."
+  :type 'file
+  :group 'http-emacs)
+
+(defconst http-token-value-regexp
+  "^[ \t]*\\(.*?\\)[ \t]*=[ \t]*\"?\\(.*?\\)\"?[ \t]*;?[ \t]*$"
+  "Regexp to match a token=\"value\"; in a cookie.")
+
+(defvar http-cookies-accept-functions
+  '(http-cookie-check-path
+    http-cookie-check-domain
+    http-cookie-check-hostname)
+  "*List of functions used to determine if we accept a cookie or not.
+If one of these function returns nil the cookie will be rejected.  Each
+function can access the free variables `cookie', `host' (from the url)
+`path' (from the URL) and `url' to make its decision.")
+
+(defvar http-cookies-host-hash
+  (make-hash-table :test 'equal)
+  "Hash to look up cookies by host name.")
+
+(defvar http-cookies-domain-hash
+  (make-hash-table :test 'equal)
+  "Hash to look up cookies by domain.")
+
+
+
+;; functions for parsing the header
+
+(defun http-cookies-ns-to-rfc (line)
+  "Make the header value LINE a bit more RFC compatible.
+Make old netscape cookies a bit more RFC 2109 compatible by quoting
+the \"expires\" value.  We need this to be able to properly split
+the header value if there is more than one cookie."
+  (let ((start 0))
+    (while (string-match "expires[ \t]*=[ \t]*\\([^\";]+?\\)\\(;\\|$\\)"
+                         line start)
+      (setq start (match-end 0))
+      (setq line (replace-match "\"\\1\"" t nil line 1)))
+    line))
+
+(defun http-cookies-find-char-in-string (char string &optional start)
+  "Return the first position of CHAR in STRING.
+If START is non-nil start at position START."
+  (unless start
+    (setq start 0))
+  (let ((i start) (len (length string)) pos)
+    (while (and (not pos) (< i len))
+      (when (= (aref string i) char)
+        (setq pos i))
+      (setq i (1+ i)))
+    pos))
+
+(defun http-cookies-find-quoted-strings (header-value)
+  "Return list of positions of quoted strings in HEADER_VALUE.
+Return a list of pairs with the beginning and end of quoted strings
+in a \"Set-cookie: \" header value."
+  (let ((start 0) qstring-pos)
+    (while (string-match "=[ \t]*\\(\".*?[^\\]\"\\)" header-value start)
+      (add-to-list 'qstring-pos (cons (match-beginning 1) (1- (match-end 1))))
+      (setq start (match-end 1)))
+    qstring-pos))
+
+(defun http-cookies-split-string (header-value sep-char)
+  "Split the HEADER-VALUE at the character SEP-CHAR.
+Ignores SEP-CHAR if it is in a quoted string.  Return a list of the
+substrings."
+  (let ((qstrings (http-cookies-find-quoted-strings header-value))
+        (start 0) (beg 0) pos in-qstring strings)
+    (while (setq pos (http-cookies-find-char-in-string
+                      sep-char header-value start))
+      (unless (= pos start)           ; ignore empty strings
+        ;; check if pos is in a quoted string
+        (dolist (qstring-pos qstrings)
+          (unless in-qstring
+            (when (and (> pos (car qstring-pos)) (< pos (cdr qstring-pos)))
+              (setq in-qstring t))))
+        (if in-qstring
+            (setq in-qstring nil)
+          (add-to-list 'strings (substring header-value beg pos))
+          (setq beg (1+ pos))))
+      (setq start (1+ pos)))
+    ;; add the last token
+    (add-to-list 'strings (substring header-value beg))
+    strings))
+
+(defun http-cookies-parse-cookie (string)
+  "Parse one cookie.
+Return an alist ((NAME . VALUE) (attr1 . value1) (attr2 . value2) ...)
+or nil on error."
+  (let (attrs error)
+    (dolist (attr (http-cookies-split-string string ?\;))
+      (if (string-match http-token-value-regexp attr)
+          (add-to-list 'attrs (cons (match-string 1 attr)
+                                    (match-string 2 attr)))
+        ;; match the secure attribute
+        (if (string-match "[ \t]*\\([a-zA-Z]+\\)[ \t]*"  attr)
+            (add-to-list 'attrs (cons (match-string 1 attr) t))
+          (setq error t)
+          (message "Cannot parse cookie %s" string))))
+    (unless error
+      attrs)))
+
+(defun http-cookies-set (url headers)
+  "Set the cookies from the response to a request of URL.
+Set HEADERS to the headers of the response."
+  (let ((host (http-cookies-url-host url)) (path (http-cookies-url-path url))
+        header-value cookie)
+    ;; The server may send several "Set-Cookie:" headers.
+    (dolist (line headers)
+      (when (equal (car line) "set-cookie")
+        (setq header-value (http-cookies-ns-to-rfc (cdr line)))
+        ;; there may be several cookies separated by ","
+        (dolist (raw-cookie (http-cookies-split-string header-value ?\,))
+          (setq cookie (http-cookies-parse-cookie raw-cookie))
+          ;; (message "%s" raw-cookie)
+          (when (http-cookies-accept)
+            ;; (message "accepted")
+            (http-cookies-store host cookie)))))))
+
+
+
+;; storing cookies
+
+(defun http-cookies-name (cookie)
+  "Return the name of the COOKIE."
+  (car (car cookie)))
+
+(defun http-cookies-path (cookie)
+  "Return the value of the path attribute of the COOKIE."
+  (let ((attr (or (assoc "path" cookie) (assoc "Path" cookie))))
+    (when attr
+      (cdr attr))))
+
+(defun http-cookies-domain (cookie)
+  "Return the value of the domain attribute of the COOKIE."
+  (let ((attr (or (assoc "domain" cookie) (assoc "Domain" cookie))))
+    (when attr
+      (cdr attr))))
+
+(defun http-cookies-expires (cookie)
+  "Return the value of the expires attribute of the COOKIE."
+  (let ((attr (assoc "expires" cookie)))
+    (when attr
+      (cdr attr))))
+
+(defun http-cookies-max-age (cookie)
+  "Return the value of the Max-Age attribute of the COOKIE."
+  (let ((attr (assoc "Max-Age" cookie)))
+    (when attr
+      (cdr attr))))
+
+(defun http-cookies-version (cookie)
+  "Return the value of the version attribute of the COOKIE."
+  (let ((version (assoc "Version" cookie)))
+    (when version
+      (if (equal version "1")
+          t
+        (message "Cookie version %s not supported." version)
+        nil))))
+
+(defun http-cookies-equal (c1 c2)
+  "Return non nil if the given cookies are equal.
+Old netscape cookies are equal if the name and path attributes are equal.
+Version 1 cookies are equal if name path and domain are equal."
+  (if (and (http-cookies-version c1) (http-cookies-version c2))
+      ;; version 1 cookies
+      (and (equal (http-cookies-name c1) (http-cookies-name c2))
+           (equal (http-cookies-path c1) (http-cookies-path c2))
+           (equal (http-cookies-domain c1) (http-cookies-domain c2)))
+    ;; netscape cookies
+    (and (equal (http-cookies-name c1) (http-cookies-name c2))
+         (equal (http-cookies-path c1) (http-cookies-path c2)))))
+
+(defun http-cookies-expired (expire-string)
+  "Return non nil if EXPIRE-STRING is in the past."
+  (> (time-to-seconds (time-since expire-string)) 0.0))
+
+(defun http-cookies-remove (cookie key table)
+  "Remove cookies \"equal\" to COOKIE from the list stored with KEY in TABLE."
+  (let ((cookie-list (gethash key table)) new-list)
+    (dolist (entry cookie-list)
+      (unless (http-cookies-equal entry cookie)
+        (add-to-list 'new-list entry)))
+    (when cookie-list
+      (remhash key table)
+      (puthash key new-list table))))
+
+(defun http-cookies-store (host cookie)
+  "Store the given COOKIE from HOST in the hash tables.
+Remove cookie from the tables if the given COOKIE expires in the past or
+has an \"Max-Age\" of 0."
+  (let ((domain (http-cookies-domain cookie))
+        (max-age (http-cookies-max-age cookie))
+        (expires (http-cookies-expires cookie))
+        (cookie-list))
+    ;; remove an possible "equal" old cookie
+    (http-cookies-remove cookie host http-cookies-host-hash)
+    (when domain
+      (http-cookies-remove cookie domain http-cookies-domain-hash))
+    ;; check if expires is in the past or Max-Age is zero
+    (unless (or (and max-age (= (string-to-number max-age) 0))
+                (and expires (http-cookies-expired expires)))
+      ;; convert "Max-Age" to "expire"
+      (when max-age
+        ;; this value does not have to be in the "right" format
+        ;; it's enough if `parse-time-string' can parse it
+        (setq expires (format-time-string
+                       "%Y-%m-%d %T %z"
+                       (time-add (current-time) (seconds-to-time max-age))
+                       t))
+        (setcdr (assoc "Max-Age" cookie) expires)
+        (setcar (assoc "Max-Age" cookie) "expires"))
+      (setq cookie-list (gethash host http-cookies-host-hash))
+      (add-to-list 'cookie-list cookie)
+      (puthash host cookie-list http-cookies-host-hash)
+      (when domain
+        (setq cookie-list (gethash domain http-cookies-domain-hash))
+        (add-to-list 'cookie-list cookie)
+        (puthash domain cookie-list http-cookies-domain-hash)))))
+
+
+
+;; building the header to send back the cookie
+
+(defun http-cookies-cookie-to-string (cookie)
+  "Return the cookie as a string to be used as a header value."
+  (let* ((name (http-cookies-name cookie))
+         (value (cdr (assoc name cookie)))
+         (path (http-cookies-path cookie))
+         (domain (http-cookies-domain cookie))
+         (string))
+    (if (http-cookies-version cookie)
+        ;; version 1 cookie
+        (progn
+          (setq string (concat "$Version = \"1\"; " name " = \"" value "\""))
+          (when path
+            (setq string (concat string "; $Path = \"" path "\"")))
+          (when domain
+            (setq string (concat string "; $Domain = \"" domain "\""))))
+      ;; netscape cookies
+      (setq string (concat name "=" value)))))
+
+(defun http-cookies-cookie-in-list (cookie list)
+  "Return non-nil if a cookie \"equal\" to the given COOKIE is in LIST."
+  (let ((in-list))
+    (dolist (element list)
+      (unless in-list
+        (setq in-list (http-cookies-equal cookie element))))
+    in-list))
+
+(defun http-cookies-path-depth (cookie)
+  "Return the number of dashes in the path attribute of the cookie."
+  (let ((patch http-cookies-path cookie) (n 0) (start 0))
+    (while (setq start (http-cookies-find-char-in-string ?\/ path start))
+      (setq n (1+ n)))
+    n))
+
+(defun http-cookie-path-depth-less (c1 c2)
+  "Return non nil if the path depth of cookie C1 is less than C2."
+  (< (http-cookies-path-depth c1) (http-cookies-path-depth c2)))
+
+(defun http-cookies-build-header (url)
+  "Return a pair (\"Cookie\" . <header value>).
+Use this to send back cookies to the given URL."
+  (let ((host (http-cookies-url-host url)) (domain) (cookie-list) (string))
+    (when (string-match "^[^.]+\\(\\..+\\)" host)
+      (setq domain (match-string 1 host))
+      (dolist (cookie (gethash host http-cookies-host-hash))
+        (unless (http-cookies-expired (http-cookies-expires cookie))
+          (add-to-list 'cookie-list cookie)))
+      (dolist (cookie (gethash domain http-cookies-domain-hash))
+        (unless (or (http-cookies-cookie-in-list cookie cookie-list)
+                    (http-cookies-expired (http-cookies-expires cookie)))
+          (add-to-list 'cookie-list cookie)))
+      (setq cookie-list (sort cookie-list 'http-cookies-path-depth-less))
+      (dolist (cookie cookie-list)
+        (if string
+            (setq string (concat string "; "
+                                 (http-cookies-cookie-to-string cookie)))
+          (setq string (http-cookies-cookie-to-string cookie)))))
+    (cons "Cookie" string)))
+
+
+
+;; extract parts of the url
+
+(defun http-cookies-url-host (url)
+  "Return the hostname of URL"
+  (unless (string-match
+           "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)"
+           url)
+    (error "Cannot parse URL %s." url))
+  (match-string 1 url))
+
+(defun http-cookies-url-path (url)
+  "Return the path of the URL."
+  (unless (string-match
+           "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)"
+           url)
+    (error "Cannot parse URL %s." url))
+  (concat "/" (or (match-string 4 url) "")))
+
+
+
+;; functions to check the cookie (implementation of 4.3.2 of RFC 2109)
+
+(defun http-cookies-accept ()
+  "Return non nil if the cookie should be accepted.
+The tests are based on the functions in `http-cookies-accept-functions'."
+  (let ((accept t))
+    (dolist (fun http-cookies-accept-functions)
+      (when accept
+        (setq accept (funcall fun))))
+    accept))
+
+(defun http-cookie-check-path ()
+  "Return nil if the \"path\" attribute is not a prefix of th URL."
+  (let ((cookie-path (cdr (assoc "path" cookie))))
+    (if cookie-path
+        (if (string-match (concat "^" cookie-path) path)
+            t
+          (message "Rejecting cookie: path attribute \"%s\" is not a prefix\
+ of the URL %s." cookie-path url)
+          nil)
+      t)))
+
+(defun http-cookie-check-domain ()
+  "Return nil if the domain is bogus.
+Return nil if the domain does not start with a \".\" or does not contain
+an embedded dot."
+  (let ((domain (cdr (assoc "domain" cookie))))
+    (if domain
+        (if (string-match "^\\.[^.]+\\.[^.]+" domain)
+            t
+          (message "Rejection cookie: domain \"%s\" does not start with a dot\
+ or does not contain an embedded dot." domain)
+          nil)
+      t)))
+
+(defun http-cookie-check-hostname ()
+  "Return nil if the domain doesn't match the host.
+Return nil if the domain attribute does not match the host name or the
+host name without the domain attribute still contains one or more dots."
+  ;; FIXME: hostname might be an IP address
+  (let ((domain (cdr (assoc "domain" cookie))))
+    (if (not domain)
+        t
+      (when (string-match (concat domain "$") host)
+        (not (http-cookies-find-char-in-string
+              ?\. (substring host 0 (match-beginning 0))))))))
+
+
+
+(provide 'http-cookies)
+
+;;; http-cookies.el ends here