view lisp/md4.el @ 87828:41248ae03f06

(org-entry-properties): Include the CLOCKSUM special property. (org-columns-edit-value): Do not allow to edit the special CLOCKSUM property. (org-flag-drawer): Use the original value of `outline-regexp'. (org-remember-handler): Add invisible-ok flag to call to `org-end-of-subtree' (org-agenda-highlight-todo): Respect `org-agenda-todo-keyword-format'. (org-agenda-todo-keyword-format): New option. (org-infile-export-plist): No restriction while searching for options. (org-remember-handler): Remove comments at the end of the buffer. (org-remember-use-refile-when-interactive): New option. (org-table-sort-lines): Make sure sorting works on link descritions only, and ignores the link. (org-sort-entries-or-items): Make sure the end of the subtree is included. (org-refile-use-outline-path): New allowed values `file' and `full-file-path'. (org-get-refile-targets): Respect new values for `org-refile-use-outline-path'. (org-agenda-get-restriction-and-command): DEL goes back to initial list. (org-export-as-xoxo): Restore point when done. (org-open-file): Allow multiple %s in command. (org-clock-in-switch-to-state): New option. (org-first-list-item-p): New function. (org-last-remember-storage-locations): New variable. (org-get-refile-targets): Interpret the new maxlevel setting. (org-refile-targets): New option `:maxlevel'. (org-copy-subtree): Include empty lines before but not after subtree. (org-back-over-empty-lines, org-skip-whitespace): New functions. (org-move-item-down, org-move-item-up): Include empty lines before but not after item. (org-first-sibling-p): New function. (org-remember-apply-template): Defaults, completions and history for template prompts. Also, interpret new `%!' escape. (org-context-choices): New constant. (org-bound-and-true-p): New macro. (org-imenu-depth): New option. (org-imenu-markers): New variable. (org-imenu-new-marker, org-imenu-get-tree) (org-speedbar-set-agenda-restriction): New functions. (org-agenda-set-restriction-lock) (org-agenda-remove-restriction-lock, org-agenda-maybe-redo): New functions. (org-agenda-restriction-lock): New face. (org-agenda-restriction-lock-overlay) (org-speedbar-restriction-lock-overlay): New variables. (org-open-at-point): Removed obsolete way to do redirection in shell links. (org-imenu-and-speedbar): New customization group. (org-entry-properties): Return keyword-less time strings. (org-clock-heading-function): New option. (org-clock-in): Use `org-clock-heading-function'. (org-calendar-holiday): Try to use `calendar-check-holidays' instead of the obsolete `check-calendar-holidays'. (org-export-html-special-string-regexps): New constant. (org-massive-special-regexp): New variable. (org-compute-latex-and-specials-regexp) (org-do-latex-and-special-faces): New functions. (org-latex-and-export-specials): New face. (org-highlight-latex-fragments-and-specials): New option. (org-link-escape-chars): Use characters instead of strings. (org-link-escape-chars-browser, org-link-escape) (org-link-unescape): Use characters instead of strings. (org-export-html-convert-sub-super, org-html-do-expand): Check for protected text. (org-emphasis-alist): Additional `verbatim' flag. (org-set-emph-re): Handle the verbatim flag and compute `org-verbatim-re'. (org-cleaned-string-for-export): Protect verbatim elements. (org-verbatim-re): New variable. (org-hide-emphasis-markers): New option. (org-additional-option-like-keywords): Add new keywords. (org-get-entry): Renamed from `org-get-cleaned-entry'. (org-icalendar-cleanup-string): New function for quoting icalendar text. (org-agenda-skip-scheduled-if-done): New option. (org-agenda-get-scheduled, org-agenda-get-blocks): Use `org-agenda-skip-scheduled-if-done'. (org-prepare-agenda-buffers): Allow buffers as arguments. (org-entry-properties): Add CATEGORY as a special property. (org-use-property-inheritance): Allow a list of properties as a value. (org-eval-in-calendar): No longer update the prompt. (org-read-date-popup-calendar): Renamed from `org-popup-calendar-for-date-prompt'. (org-read-date-display-live): New variable. (org-read-date-display): New function. (org-read-date-analyze): New function. (org-remember-apply-template): Define `remember-finalize' if it is not yet defined. (org-remember-insinuate): New function. (org-read-date-prefer-future): New option. (org-read-date): Respect the setting of `org-read-date-prefer-future'. Use `org-read-date-analyze'. (org-set-font-lock-defaults): Use `org-archive-tag' instead of a hardcoded string. (org-remember-apply-template): Use `remember-finalize' instead of `remember-buffer'. (org-columns-compute, org-column-number-to-string) (org-columns-uncompile-format, org-columns-compile-format) (org-columns-compile-format): Handle printf format specifier. (org-columns-new, org-column-number-to-string) (org-columns-uncompile-format, org-columns-compile-format): Support for new currency summary type. (org-tree-to-indirect-buffer): Do not kill old buffer when `org-indirect-buffer-display' is `new-frame'. (org-indirect-buffer-display): Document that `new-frame' leads to indiret buffer proliferation. (org-agenda-list): Use `org-extend-today-until'. (org-extend-today-until): New option. (org-format-org-table-html): Use lower-case for <col> tag. (org-agenda-execute): New command. (org-agenda-mode-map): Keybindings of "g" "G", "e" modified. (org-select-remember-template): New function. (org-remember-apply-template): Use `org-select-remember-template'. (org-go-to-remember-target): New function.

;;; md4.el --- MD4 Message Digest Algorithm.

;; Copyright (C) 2001, 2004, 2007, 2008  Free Software Foundation, Inc.

;; Author: Taro Kawagishi <[e-mail]>
;; Keywords: MD4
;; Version: 1.00
;; Created: February 2001

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Code:

;;;
;;; MD4 hash calculation

(defvar md4-buffer (make-vector 4 '(0 . 0))
  "work buffer of four 32-bit integers")

(defun md4 (in n)
  "Returns the MD4 hash string of 16 bytes long for a string IN of N
bytes long.  N is required to handle strings containing character 0."
  (let (m
	(b (cons 0 (* n 8)))
	(i 0)
	(buf (make-string 128 0)) c4)
    ;; initial values
    (aset md4-buffer 0 '(26437 . 8961))		;0x67452301
    (aset md4-buffer 1 '(61389 . 43913))	;0xefcdab89
    (aset md4-buffer 2 '(39098 . 56574))	;0x98badcfe
    (aset md4-buffer 3 '(4146 . 21622))		;0x10325476

    ;; process the string in 64 bits chunks
    (while (> n 64)
      (setq m (md4-copy64 (substring in 0 64)))
      (md4-64 m)
      (setq in (substring in 64))
      (setq n (- n 64)))

    ;; process the rest of the string (length is now n <= 64)
    (setq i 0)
    (while (< i n)
      (aset buf i (aref in i))
      (setq i (1+ i)))
    (aset buf n 128)			;0x80
    (if (<= n 55)
	(progn
	  (setq c4 (md4-pack-int32 b))
	  (aset buf 56 (aref c4 0))
	  (aset buf 57 (aref c4 1))
	  (aset buf 58 (aref c4 2))
	  (aset buf 59 (aref c4 3))
	  (setq m (md4-copy64 buf))
	  (md4-64 m))
      ;; else
      (setq c4 (md4-pack-int32 b))
      (aset buf 120 (aref c4 0))
      (aset buf 121 (aref c4 1))
      (aset buf 122 (aref c4 2))
      (aset buf 123 (aref c4 3))
      (setq m (md4-copy64 buf))
      (md4-64 m)
      (setq m (md4-copy64 (substring buf 64)))
      (md4-64 m)))

    (concat (md4-pack-int32 (aref md4-buffer 0))
	    (md4-pack-int32 (aref md4-buffer 1))
	    (md4-pack-int32 (aref md4-buffer 2))
	    (md4-pack-int32 (aref md4-buffer 3))))

(defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z)))
(defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z)))
(defsubst md4-H (x y z) (logxor x y z))

(defmacro md4-make-step (name func)
  `(defun ,name (a b c d xk s ac)
     (let*
         ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac)))
          (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
          (h2 (logand 65535 (+ h1 (lsh l1 -16))))
          (l2 (logand 65535 l1))
	  ;; cyclic shift of 32 bits integer
          (h3 (logand 65535 (if (> s 15)
                                (+ (lsh h2 (- s 32)) (lsh l2 (- s 16)))
                              (+ (lsh h2 s) (lsh l2 (- s 16))))))
          (l3 (logand 65535 (if (> s 15)
                                (+ (lsh l2 (- s 32)) (lsh h2 (- s 16)))
                              (+ (lsh l2 s) (lsh h2 (- s 16)))))))
       (cons h3 l3))))

(md4-make-step md4-round1 md4-F)
(md4-make-step md4-round2 md4-G)
(md4-make-step md4-round3 md4-H)

(defsubst md4-add (x y)
  "Return 32-bit sum of 32-bit integers X and Y."
  (let ((h (+ (car x) (car y)))
	(l (+ (cdr x) (cdr y))))
    (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l))))

(defsubst md4-and (x y)
  (cons (logand (car x) (car y)) (logand (cdr x) (cdr y))))

(defun md4-64 (m)
  "Calculate md4 of 64 bytes chunk M which is represented as 16 pairs of
32 bits integers.  The resulting md4 value is placed in md4-buffer."
  (let ((a (aref md4-buffer 0))
	(b (aref md4-buffer 1))
	(c (aref md4-buffer 2))
	(d (aref md4-buffer 3)))
    (setq a (md4-round1 a b c d (aref m  0)   3 '(0 . 0))
	  d (md4-round1 d a b c (aref m  1)   7 '(0 . 0))
	  c (md4-round1 c d a b (aref m  2)  11 '(0 . 0))
	  b (md4-round1 b c d a (aref m  3)  19 '(0 . 0))
	  a (md4-round1 a b c d (aref m  4)   3 '(0 . 0))
	  d (md4-round1 d a b c (aref m  5)   7 '(0 . 0))
	  c (md4-round1 c d a b (aref m  6)  11 '(0 . 0))
	  b (md4-round1 b c d a (aref m  7)  19 '(0 . 0))
	  a (md4-round1 a b c d (aref m  8)   3 '(0 . 0))
	  d (md4-round1 d a b c (aref m  9)   7 '(0 . 0))
	  c (md4-round1 c d a b (aref m 10)  11 '(0 . 0))
	  b (md4-round1 b c d a (aref m 11)  19 '(0 . 0))
	  a (md4-round1 a b c d (aref m 12)   3 '(0 . 0))
	  d (md4-round1 d a b c (aref m 13)   7 '(0 . 0))
	  c (md4-round1 c d a b (aref m 14)  11 '(0 . 0))
	  b (md4-round1 b c d a (aref m 15)  19 '(0 . 0))

	  a (md4-round2 a b c d (aref m  0)   3 '(23170 . 31129)) ;0x5A827999
	  d (md4-round2 d a b c (aref m  4)   5 '(23170 . 31129))
	  c (md4-round2 c d a b (aref m  8)   9 '(23170 . 31129))
	  b (md4-round2 b c d a (aref m 12)  13 '(23170 . 31129))
	  a (md4-round2 a b c d (aref m  1)   3 '(23170 . 31129))
	  d (md4-round2 d a b c (aref m  5)   5 '(23170 . 31129))
	  c (md4-round2 c d a b (aref m  9)   9 '(23170 . 31129))
	  b (md4-round2 b c d a (aref m 13)  13 '(23170 . 31129))
	  a (md4-round2 a b c d (aref m  2)   3 '(23170 . 31129))
	  d (md4-round2 d a b c (aref m  6)   5 '(23170 . 31129))
	  c (md4-round2 c d a b (aref m 10)   9 '(23170 . 31129))
	  b (md4-round2 b c d a (aref m 14)  13 '(23170 . 31129))
	  a (md4-round2 a b c d (aref m  3)   3 '(23170 . 31129))
	  d (md4-round2 d a b c (aref m  7)   5 '(23170 . 31129))
	  c (md4-round2 c d a b (aref m 11)   9 '(23170 . 31129))
	  b (md4-round2 b c d a (aref m 15)  13 '(23170 . 31129))

	  a (md4-round3 a b c d (aref m  0)   3 '(28377 . 60321)) ;0x6ED9EBA1
	  d (md4-round3 d a b c (aref m  8)   9 '(28377 . 60321))
	  c (md4-round3 c d a b (aref m  4)  11 '(28377 . 60321))
	  b (md4-round3 b c d a (aref m 12)  15 '(28377 . 60321))
	  a (md4-round3 a b c d (aref m  2)   3 '(28377 . 60321))
	  d (md4-round3 d a b c (aref m 10)   9 '(28377 . 60321))
	  c (md4-round3 c d a b (aref m  6)  11 '(28377 . 60321))
	  b (md4-round3 b c d a (aref m 14)  15 '(28377 . 60321))
	  a (md4-round3 a b c d (aref m  1)   3 '(28377 . 60321))
	  d (md4-round3 d a b c (aref m  9)   9 '(28377 . 60321))
	  c (md4-round3 c d a b (aref m  5)  11 '(28377 . 60321))
	  b (md4-round3 b c d a (aref m 13)  15 '(28377 . 60321))
	  a (md4-round3 a b c d (aref m  3)   3 '(28377 . 60321))
	  d (md4-round3 d a b c (aref m 11)   9 '(28377 . 60321))
	  c (md4-round3 c d a b (aref m  7)  11 '(28377 . 60321))
	  b (md4-round3 b c d a (aref m 15)  15 '(28377 . 60321)))

    (aset md4-buffer 0 (md4-add a (aref md4-buffer 0)))
    (aset md4-buffer 1 (md4-add b (aref md4-buffer 1)))
    (aset md4-buffer 2 (md4-add c (aref md4-buffer 2)))
    (aset md4-buffer 3 (md4-add d (aref md4-buffer 3)))
    ))

(defun md4-copy64 (seq)
  "Unpack a 64 bytes string into 16 pairs of 32 bits integers."
  (let ((int32s (make-vector 16 0)) (i 0) j)
    (while (< i 16)
      (setq j (* i 4))
      (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8))
			   (+ (aref seq j) (lsh (aref seq (1+ j)) 8))))
      (setq i (1+ i)))
    int32s))

;;;
;;; sub functions

(defun md4-pack-int16 (int16)
  "Pack 16 bits integer in 2 bytes string as little endian."
  (let ((str (make-string 2 0)))
    (aset str 0 (logand int16 255))
    (aset str 1 (lsh int16 -8))
    str))

(defun md4-pack-int32 (int32)
  "Pack 32 bits integer in a 4 bytes string as little endian.  A 32 bits
integer is represented as a pair of two 16 bits integers (cons high low)."
  (let ((str (make-string 4 0))
	(h (car int32)) (l (cdr int32)))
    (aset str 0 (logand l 255))
    (aset str 1 (lsh l -8))
    (aset str 2 (logand h 255))
    (aset str 3 (lsh h -8))
    str))

(defun md4-unpack-int16 (str)
  (if (eq 2 (length str))
      (+ (lsh (aref str 1) 8) (aref str 0))
    (error "%s is not 2 bytes long" str)))

(defun md4-unpack-int32 (str)
  (if (eq 4 (length str))
      (cons (+ (lsh (aref str 3) 8) (aref str 2))
	    (+ (lsh (aref str 1) 8) (aref str 0)))
    (error "%s is not 4 bytes long" str)))

(provide 'md4)

;;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e
;;; md4.el ends here