1 ;;; planner-authz.el --- restrict portions of published pages
3 ;; Copyright (C) 2004, 2005, 2006, 2008 Andrew J. Korty <ajk@iu.edu>
4 ;; Parts copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Emacs Lisp Archive Entry
7 ;; Filename: planner-authz.el
8 ;; Keywords: hypermedia
9 ;; Author: Andrew J. Korty <ajk@iu.edu>
10 ;; Maintainer: Andrew J. Korty <ajk@iu.edu>
11 ;; Description: Control access to portions of published planner pages
13 ;; Compatibility: Emacs20, Emacs21, Emacs22, XEmacs21
15 ;; This file is part of Planner. It is not part of GNU Emacs.
17 ;; Planner is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by
19 ;; the Free Software Foundation; either version 3, or (at your option)
22 ;; Planner is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 ;; General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with Planner; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
30 ;; Boston, MA 02110-1301, USA.
34 ;; This library lets you publish your planner pages while controlling
35 ;; access to certain portions of them to users you specify. When you
36 ;; load this library, you gain access to two additional markup
37 ;; directives to use in your planner pages. The <authz> tag lets you
38 ;; restrict access to arbitrary content as follows:
40 ;; Here is a sentence everyone should see. This sentence also
41 ;; contains no sensitive data whatsoever. <authz users="ajk">This
42 ;; sentence, however, talks about my predilection for that French
43 ;; vanilla instant coffee that comes in the little tin, and I'm
44 ;; embarrassed for anyone else to know about that.</authz> And
45 ;; here's some more perfectly innocuous content.
47 ;; You can use <authz> tags to mark up entire paragraphs, tasks,
48 ;; notes, and anything else. The tags are replaced with Mason code by
49 ;; default, but you could add support for some other templating system
50 ;; by configuring planner-authz-mason-markup-strings and
51 ;; planner-authz-after-publish-hook.
53 ;; The #authz directive restricts access to an entire page. It will
54 ;; generate a 403 error when someone not listed tries to access it.
55 ;; Any notes or tasks on a #authz-protected page are also wrapped in
56 ;; authorization controls on linked pages.
60 ;; If your pages have a section with diary entries maintained by
61 ;; planner-appt.el (or by any other means), you can control access to
62 ;; these entries. First, customize `planner-section-tagnames' to map
63 ;; your diary section ("* Schedule", in this example) to a tag called
64 ;; "diary-section", for example:
66 ;; (add-to-list 'planner-section-tagnames '("Schedule" . "diary-section"))
68 ;; If the name of your diary section is "* Diary", you will not need
69 ;; to customize `planner-section-tagnames' by default.
71 ;; Then make sure the diary entries you want restricted contain a
72 ;; corresponding plan page name in parentheses, for example:
74 ;; 10:00 10:30 Meeting with boss (WorkStuff)
78 ;; Add the following to your .emacs file to cause
79 ;; M-x muse-project-publish to automatically use planner-authz
82 ;; (require 'planner-authz)
86 ;; All user-serviceable options can be customized with
87 ;; M-x customize-group RET planner-authz RET.
91 ;; The following customization options let you set default access
92 ;; lists for pages that don't have explicit settings:
94 ;; planner-authz-project-default
96 ;; Default access list for project pages (not day pages). If a
97 ;; given project page doesn't contain a #authz tag, it will receive
98 ;; the access list defined here. If this variable is nil, all users
99 ;; will be allowed to view the page. No corresponding variable is
100 ;; provided for day pages because it doesn't seem like you'd ever
101 ;; want to control access based on what day it was. (But I will
102 ;; accept patches. :) Notes and tasks referencing pages without
103 ;; #authz tags will also be restricted to the users listed here.
105 ;; planner-authz-day-note-default
107 ;; Default access list for notes on day pages not associated with
108 ;; any project. There is way to set a default for notes on project
109 ;; pages for the reason above; they would only be associated with
110 ;; date pages anyway.
112 ;; planner-authz-day-task-default
114 ;; Same as above but for tasks.
118 ;; - Make more specific tags override less specific ones, rather than
119 ;; more restrictive overriding less restrictive
123 (require 'planner-publish
)
125 ;; Customization options
127 (defgroup planner-authz nil
128 "A planner.el extension for restricting portions of your
129 published pages to specified users."
131 :prefix
"planner-authz")
133 (defcustom planner-authz-after-publish-hook
134 '(planner-authz-generate-mason-component)
135 "Functions called after all pages have been published."
136 :group
'planner-authz
139 (defcustom planner-authz-appt-alt nil
140 "If non-nil, show `planner-appt' appointments to users not
141 authorized to see them, but replace the text of the appointment with
142 the contents of this variable. If nil, don't show any part of an
143 appointment to an unauthorized user.
145 For example, if this variable is set to \"Private appointment\" and
146 some hypothetical user is not authorized for the SecretStuff page, an
147 appointment that was entered as
149 #A1 _ @10:00 12:00 Secret meeting (SecretStuff)
151 would appear to our unauthorized user as
153 #A1 _ @10:00 12:00 Private appointment"
154 :group
'planner-authz
155 :type
'(choice (string :tag
"Replacement text")
156 (const :tag
"Disable" nil
)))
158 (defcustom planner-authz-appt-regexp
159 (if (require 'planner-appt nil t
)
160 (concat "\\(?:[@!][ \t]*\\)?\\(?:" planner-appt-time-regexp
161 "\\| \\)\\(?:[ \t|]+\\(?:" planner-appt-time-regexp
162 "\\| \\)\\)?[ \t|]+"))
163 "Regexp that matches a `planner-appt' start and end time specification."
164 :group
'planner-authz
167 (defcustom planner-authz-day-note-default nil
168 "Default list of users for restricting non-project notes on day pages."
169 :group
'planner-authz
170 :type
'(repeat string
))
172 (defcustom planner-authz-day-task-default nil
173 "Default list of users for restricting non-project tasks on day pages."
174 :group
'planner-authz
175 :type
'(repeat string
))
177 (defcustom planner-authz-link-regexp
178 (concat "(\\(" muse-explicit-link-regexp
179 (if (boundp 'muse-wiki-wikiword-regexp
)
180 (concat "\\|" muse-wiki-wikiword-regexp
))
181 "\\|" muse-implicit-link-regexp
"\\))$")
182 "Regexp that matches the plan page link at the end of a line in a
183 task or diary entry."
184 :group
'planner-authz
187 (defcustom planner-authz-mason-component-contents
190 my $r_user = $r ? $r->connection->user
191 : $ENV{REMOTE_USER} or return 0;
192 foreach (@_) { return 1 if $r_user eq $_ }
201 % if (authz @users) {
208 <%args>@users</%args>
210 unless (authz @users) {
217 "Mason code to be stored in a component.
218 The component's name is determined from
219 `planner-authz-mason-component-name'."
220 :group
'planner-authz
223 (defcustom planner-authz-mason-component-name
"authz.mas"
224 "Name of Mason component that restricts content."
225 :group
'planner-authz
228 (defcustom planner-authz-multi-func
'planner-authz-multi-union
229 "*Function used to combine access lists for multiple planner pages.
231 When `planner-multi' is in effect and a task or note is linked to
232 multiple plan pages, `planner-authz' uses this function to decide how
233 to build the access list for the task or note from the access lists of
236 It is passed a list of sublists, each sublist being the access list (a
237 list of usernames) for one of the linked pages. It should return a
238 combined single list of usernames.
240 Two such functions are provided: `planner-authz-multi-intersection'
241 returns only those user names that are common to all the access lists
242 for all the linked pages, and `planner-authz-multi-union' returns a
243 list of all the unique user names in any of those access lists."
244 :group
'planner-authz
245 :type
'(radio (function-item :tag
"Intersection"
246 planner-authz-multi-intersection
)
247 (function-item :tag
"Union" planner-authz-multi-union
)
248 (function :tag
"Other")))
251 (defcustom planner-authz-project-default nil
252 "Default list of users for restricting project pages if #authz is nil."
253 :group
'planner-authz
254 :type
'(repeat string
))
256 (defcustom planner-authz-sections-regexp
"^\\([*]\\)+\\s-+\\(.+\\)"
257 "Regexp that matches headings for sections authorization markup."
258 :group
'planner-authz
261 (defcustom planner-authz-sections-rule-list nil
262 "List of sections and their access rule.
264 Each rule is a sublist of the form:
266 (SECTION-NAME PREDICTION USER-LIST)
268 For sections matching SECTION-NAME, if the PREDICTION is t or a
269 function return t, that section will be accessable for users in
272 The following example will make the \"Timeclock\" section and
273 \"Accomplishments\" section on day pages only accessable by user1 and
274 user2, while on plan pages obey the \"parent\" rule.
276 ((\"Timeclock\" planner-authz-day-p
277 (\"user1\" \"user2\"))
278 (\"Accomplishments\" planner-authz-day-p
279 (\"user1\" \"user2\")))"
280 :group
'planner-authz
281 :type
'(repeat (regexp (choice boolean function
))
284 (defcustom planner-authz-markup-regexps
285 '((2300 "\\(<li>\\)\\(<&| [^<]*>\\)\\(.*\\)\\(</&>\\)\\(</li>\\)" 3
286 planner-authz-fix-list-item
))
287 "List of markup rules for publishing PLANNER with `planner-authz' restrictions.
288 For more on the structure of this list, see `muse-publish-markup-regexps'."
289 :group
'planner-authz
290 :type
'(repeat (choice
291 (list :tag
"Markup rule"
293 (choice regexp symbol
)
295 (choice string function symbol
))
298 (defcustom planner-authz-markup-functions
299 '((table . planner-authz-mason-markup-table
))
300 "An alist of style types to custom functions for that kind of text."
301 :group
'planner-authz
302 :type
'(alist :key-type symbol
:value-type function
))
304 (defcustom planner-authz-markup-tags
305 '(("authz" t t nil planner-authz-tag
)
306 ("diary-section" t t nil planner-authz-diary-section-tag
)
307 ("note" t t nil planner-authz-note-tag
)
308 ("task" t t nil planner-authz-task-tag
))
309 "A list of tag specifications for authorization markup."
310 :group
'planner-authz
311 :type
'(repeat (list (string :tag
"Markup tag")
312 (boolean :tag
"Expect closing tag" :value t
)
313 (boolean :tag
"Parse attributes" :value nil
)
314 (boolean :tag
"Nestable" :value nil
)
317 (defcustom planner-authz-mason-markup-strings
318 '((planner-authz-begin .
"<&| authz.mas:content, 'users', [qw(%s)] &>")
319 (planner-authz-begin-alt
320 .
"<&| authz.mas:content, 'users', [qw(%s)], 'alt', '%s' &>")
321 (planner-authz-end .
"</&>")
322 (planner-authz-page .
"<& authz.mas:page, 'users', [qw(%s)] &>"))
323 "Strings used for additing authorization controls.
325 If a markup rule is not found here, `planner-html-markup-strings' is
327 :type
'(alist :key-type symbol
:value-type string
)
328 :group
'planner-authz
)
330 ;; Non-customizable variables
332 (defvar planner-authz-pages nil
333 "Alist of planner pages and users authorized to view them.
334 The list of users is separated by spaces. This variable is
335 internal to planner-authz; do not set it manually.")
336 (defvar planner-authz-publishing-alist nil
337 "Alist used by `planner-authz' to track published pages and their dependencies.
338 This alist stores pages that have been published during the current
339 publishing process, as (PAGENAME . t), and pages whose tasks and notes
340 depend on those pages for access control, as (PAGENAME . nil). At the
341 end of publishing, `planner-authz' uses this alist to determine which
342 dependencies need to be republished, even if they themselves haven't
344 (defvar planner-authz-disable-dependency-publishing nil
345 "If non-nil, `planner-authz' will not republish unchanged pages whose tasks or notes depend on the page currently being published.
346 Normally, linked pages are republished in case the access list for the
347 current page has changed. This variable is set to t while
348 `planner-authz' is republishing dependent pages to avoid indefinite
353 (defun planner-authz-after-markup ()
354 "Remove the page currently being marked up from the queue of pages
355 to republish and enforce default access controls for project pages."
356 (let ((page (planner-page-name)))
359 (let ((cell (assoc page planner-authz-publishing-alist
)))
362 ;; if already t, the list is stale; whack it
364 (setq planner-authz-publishing-alist
'(page . t
)))
366 (push '(page . t
) planner-authz-publishing-alist
)))
368 (let ((users (planner-authz-users)))
370 (goto-char (point-min))
371 (planner-insert-markup (muse-markup-text 'planner-authz-page users
))
374 (defun planner-authz-after-project-publish (project)
375 "Republish pages that reference restricted pages and call the
376 generate Mason code."
377 (when (string= planner-project
(car project
))
378 (while planner-authz-publishing-alist
379 (if (not (cdar planner-authz-publishing-alist
))
380 (let ((planner-authz-disable-dependency-publishing t
))
381 (muse-project-publish-file (caar planner-authz-publishing-alist
)
383 (setq planner-authz-publishing-alist
384 (cdr planner-authz-publishing-alist
)))
385 (run-hook-with-args 'planner-authz-after-publish-hook project
)))
387 (defun planner-authz-before-markup ()
388 "Process #authz directives when publishing only a single page. Mark
389 planner page sections according to
390 `planner-authz-sections-rule-list'."
391 (planner-authz-markup-all-sections))
393 (defun planner-authz-day-p (&optional page
)
394 "Return non-nil if the current page or PAGE is a day page."
396 (string-match planner-date-regexp
(or page
(planner-page-name)))))
398 (defun planner-authz-default (page)
399 "Return the default space-separated string of users that would apply
400 to PAGE. Nil is always returned for day pages."
401 (and planner-authz-project-default
402 (not (planner-authz-day-p page
)) ; not on day pages
403 (mapconcat 'identity planner-authz-project-default
" ")))
405 (defun planner-authz-file-alist (users)
406 "Generate a list of planner files that USERS have access to."
407 (let ((pages (planner-file-alist))
412 (insert-file-contents-literally (cdar pages
))
413 (when (re-search-forward "^#authz\\s-+\\(.+\\)\n+" nil t
)
414 (let ((users-iter users
)
415 (authz (split-string (match-string 1))))
416 (while (and users-iter
(not not-found-p
))
417 (unless (member (car users-iter
) authz
)
418 (setq not-found-p t
))
419 (setq users-iter
(cdr users-iter
)))))
421 (setq result
(append (list (car pages
)) result
))))
422 (setq pages
(cdr pages
))))
425 (defun planner-authz-fix-list-item ()
426 "Rearrange list items restricted by `planner-authz' to avoid empty list items on the published page."
427 (replace-match "\\2\\1\\3\\5\\4")
428 (muse-publish-mark-read-only (match-beginning 0) (match-end 2))
429 (muse-publish-mark-read-only (match-beginning 4) (match-end 0)))
431 (defun planner-authz-generate-mason-component (project)
432 "Generate the Mason component restricting content.
433 The component's name is taken from
434 `planner-authz-mason-component-name' and initialized with the
435 contents of `planner-authz-mason-component-contents'. The
436 component restricts access to users specified by <authz> and
439 (insert planner-authz-mason-component-contents
)
440 (let ((backup-inhibited t
)
441 (styles (cddr project
)))
443 (let ((path (muse-style-element :path
(car styles
))))
445 (string-match "mason" (muse-style-element :base
(car styles
)))
447 (concat (file-name-directory path
)
448 planner-authz-mason-component-name
))))
449 (setq styles
(cdr styles
))))))
451 (defun planner-authz-markup-section-predict (rule)
452 "Check if the prediction is satisfied."
453 (let ((predict (elt rule
1)))
454 (if (functionp predict
)
458 (defun planner-authz-markup-section ()
459 "Restrict section according to `planner-authz-sections-rule-list'."
460 (let ((begin (planner-line-beginning-position))
461 (rule-list planner-authz-sections-rule-list
)
467 (re-search-forward planner-authz-sections-regexp nil t
)
468 (setq section-level
(length (match-string 1)))
469 (setq section-name
(match-string 2)))
470 (let ((rule (catch 'done
472 (if (string-match (caar rule-list
) section-name
)
473 (throw 'done
(car rule-list
))
474 (setq rule-list
(cdr rule-list
))))
477 (planner-authz-markup-section-predict rule
))
480 (muse-publish-surround-text
481 (format "<authz users=\"%s\">\n"
482 (mapconcat 'identity
(elt rule
2) " "))
487 (re-search-forward planner-authz-sections-regexp nil t
)
488 (while (and (not found
)
489 (re-search-forward planner-authz-sections-regexp
491 (if (<= (length (match-string 1))
495 (goto-char (planner-line-beginning-position))
496 (goto-char (point-max))))))))))))
498 (defun planner-authz-markup-all-sections ()
499 "Run `planner-authz-markup-section' on the entire buffer."
500 (goto-char (point-min))
501 (while (re-search-forward planner-authz-sections-regexp nil t
)
502 (planner-authz-markup-section)))
504 (defun planner-authz-mason-markup-table ()
505 "Protect \"<&|\" Mason constructs from Muse table markup."
506 (let* ((beg (planner-line-beginning-position))
507 (style (muse-style-element :base
(muse-style)))
509 (muse-style-element :base style
)))
511 (muse-find-markup-element
512 :functions
'table
(muse-style-element :base base
)))))
513 (when (functionp func
)
517 (while (search-forward "<&|" (line-end-position) t
)
518 (replace-match "<&:" t t
))))
522 (while (search-forward "<&:" end t
)
523 (replace-match "<&|" t t
))))))
526 (defun planner-authz-index-as-string (&optional as-list exclude-private
)
527 "Generate an index of all Muse pages with authorization controls.
528 In the published index, only those links to pages which the remote
529 user is authorized to access will be shown.
530 If AS-LIST is non-nil, insert a dash and spaces before each item.
531 If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions.
532 If EXCLUDE-CURRENT is non-nil, exclude the current file from the output."
534 (insert (planner-index-as-string as-list exclude-private
))
535 (when muse-publishing-p
536 (goto-char (point-min))
537 (while (and (re-search-forward
539 (concat "^[" muse-regexp-blank
"]+-["
540 muse-regexp-blank
"]*")
541 (concat "^[" muse-regexp-blank
"]*"))
543 (looking-at muse-explicit-link-regexp
))
544 (let* ((link (buffer-substring (point) (line-end-position)))
545 (page (planner-link-base link
))
546 (users (if page
(planner-authz-users page
))))
549 (insert (format "<authz users=\"%s\">" users
))
553 (buffer-substring (point-min) (point-max))))
555 (defun planner-authz-republish-dependencies-maybe (linked-pages)
556 "Remember LINKED-PAGES to be republished later.
557 The pages will be republished if and only if the current page is
559 (and (not planner-authz-disable-dependency-publishing
)
560 (planner-authz-users)
562 (unless (assoc (car linked-pages
) planner-authz-publishing-alist
)
563 (push '(car linked-pages
) planner-authz-publishing-alist
))
564 (setq linked-pages
(cdr linked-pages
)))))
566 (defun planner-authz-tag (beg end attrs
)
567 "Publish <authz> tags. The region from BEG to END is protected.
568 ATTRS should be an alist of tag attributes including \"users\" and
569 optionally \"alt\" for alternative text to be displayed to
572 (let ((alt (or (cdr (assoc "alt" attrs
)) ""))
573 (users (or (cdr (assoc "users" attrs
)) "")))
575 (planner-insert-markup
576 (if (zerop (length alt
))
577 (muse-markup-text 'planner-authz-begin users
)
578 (muse-markup-text 'planner-authz-begin-alt users alt
)))
580 (planner-insert-markup (muse-markup-text 'planner-authz-end
)))))
582 (defun planner-authz-diary-section-tag (beg end attrs
)
583 "Restrict entries in a diary section."
586 (narrow-to-region beg end
)
587 (planner-publish-nested-section-tag beg end
)
589 (while (and (zerop (forward-line))
590 (= (point) (planner-line-beginning-position)))
591 (unless (looking-at "^\\(?:[ \t]*\\|No entries\\|</div>\\)$")
592 (let ((line-begin (point))
593 (line-end (line-end-position)))
594 (re-search-forward planner-authz-link-regexp line-end t
)
595 (let* ((link (match-string 1))
596 (linked-pages (if link
597 (mapcar 'planner-link-base
598 (if (featurep 'planner-multi
)
599 (planner-multi-split link
)
603 (planner-authz-multi-users linked-pages
)
604 (and planner-authz-day-task-default
605 (mapconcat 'identity planner-authz-day-task-default
608 (if (and planner-authz-appt-alt planner-authz-appt-regexp
610 (goto-char line-begin
)
612 planner-authz-appt-regexp line-end t
)))
614 (search-forward " - " (+ 2 (point)) t
)
615 (planner-insert-markup
616 (muse-markup-text 'planner-authz-begin-alt linked-users
617 planner-authz-appt-alt
)))
618 (planner-insert-markup
619 (muse-markup-text 'planner-authz-begin linked-users
)))
621 (planner-insert-markup
622 (muse-markup-text 'planner-authz-end
))))))))))
624 (defun planner-authz-note-tag (beg end attrs
)
625 "Restrict notes linked to a restricted page. If this page is
626 restricted and the note is linked to another page, remember to
627 republish that page later and restrict the note as it appears there.
628 Call `planner-publish-note-tag' as a side effect."
631 (narrow-to-region beg end
)
632 (planner-publish-note-tag beg end attrs
)
633 (let* ((categories (cdr (assoc "categories" attrs
)))
634 (links (if (or (not categories
) (zerop (length categories
)))
635 (cdr (assoc "link" attrs
))
637 (linked-pages (if (and links
(not (zerop (length links
))))
638 (mapcar 'planner-link-base
639 (if (featurep 'planner-multi
)
640 (planner-multi-split links
)
644 (planner-authz-multi-users linked-pages
)
645 (and planner-authz-day-note-default
646 (planner-authz-day-p)
648 planner-authz-day-note-default
" ")))))
650 ;; If this note is linked to another page, republish that page
651 ;; later to restrict the note as it appears there, providing that
652 ;; page has an authz restriction
655 (planner-authz-republish-dependencies-maybe linked-pages
))
657 ;; If the linked page has an authz restriction, restrict this note
660 (goto-char (point-min))
661 (planner-insert-markup
662 (muse-markup-text 'planner-authz-begin linked-users
))
664 (goto-char (point-max))
665 (planner-insert-markup (muse-markup-text 'planner-authz-end
))
668 (defun planner-authz-task-tag (beg end attrs
)
669 "Restrict tasks linked to restricted pages. If this page is
670 restricted and the task is linked to another page, remember to
671 republish that page later and restrict the task as it appears there.
672 Call `planner-publish-task-tag' as a side effect."
675 (narrow-to-region beg end
)
676 (planner-publish-task-tag beg end attrs
)
677 (let* ((link (cdr (assoc "link" attrs
)))
678 (linked-pages (if link
679 (mapcar 'planner-link-base
680 (if (featurep 'planner-multi
)
681 (planner-multi-split link
)
685 (planner-authz-multi-users linked-pages
)
686 (and planner-authz-day-task-default
687 (planner-authz-day-p)
689 planner-authz-day-task-default
" ")))))
691 ;; If this task is linked to another page, republish that page
692 ;; later to restrict the task as it appears there, providing that
693 ;; page has an authz restriction
696 (planner-authz-republish-dependencies-maybe linked-pages
))
698 ;; If the linked page has an authz restriction, restrict this task
701 (goto-char (point-min))
702 (planner-insert-markup
703 (muse-markup-text 'planner-authz-begin linked-users
))
704 (goto-char (point-max))
705 (planner-insert-markup (muse-markup-text 'planner-authz-end
)))))))
707 (defun planner-authz-users (&optional page
)
708 "Return a list of acceptable users for PAGE.
709 The list of users is returned as space-separated string, based on
710 a #authz directive appearing in the page. If PAGE contains no
711 #authz directive and is a project page (it doesn't match
712 `planner-date-regexp'), return `planner-authz-project-default' as
713 a space-separated string.
715 If PAGE is nil, return a list of users associated with the
717 (unless page
(setq page
(planner-page-name)))
718 (let ((match (cdr (assoc page planner-authz-pages
))))
720 (let ((file (cdr (assoc page
(planner-file-alist)))))
724 (insert-file-contents-literally file
)
725 (if (re-search-forward "^#authz\\s-+\\(.+\\)\n+"
728 (planner-authz-default page
))))
729 (push `(,page .
,match
) planner-authz-pages
))
732 (defun planner-authz-multi-intersection (list)
733 "Merge a list of `planner-authz' access lists, returning a list of only those user names that are common to all the passed access lists."
734 (let ((count (length list
))
735 alist intersection sublist
)
737 ;; in alist, associate each name with its frequency of appearance
739 (setq sublist
(car list
))
741 (let ((entry (assoc (car sublist
) alist
)))
743 (setcdr entry
(1+ (cdr entry
)))
744 (setq alist
(cons `(,(car sublist
) .
1) alist
))))
745 (setq sublist
(cdr sublist
)))
746 (setq list
(cdr list
)))
748 ;; those names with `count' frequencies were in every sublist
750 (if (= (cdar alist
) count
)
751 (setq intersection
(cons (caar alist
) intersection
)))
752 (setq alist
(cdr alist
)))
755 (defun planner-authz-multi-union (list)
756 "Merge a list of `planner-authz' access lists, returning a list of all the unique user names in any of those access lists."
759 (setq sublist
(car list
))
761 (add-to-list 'union
(car sublist
))
762 (setq sublist
(cdr sublist
)))
763 (setq list
(cdr list
)))
766 (defun planner-authz-multi-users (pages)
767 "Return a merged access list for PAGES.
768 The list of users is returned as space-separated string, based on a
769 #authz directive appearing in the PAGES. If one of PAGES contains no
770 #authz directive and is a project page (it doesn't match
771 `planner-date-regexp'), it will contribute
772 `planner-authz-project-default' to the merge."
774 (funcall planner-authz-multi-func
775 (mapcar (lambda (page)
776 (if (not (planner-authz-day-p page
))
777 (let ((users (planner-authz-users page
)))
779 (split-string users
)))))
782 (mapconcat 'identity users
" "))))
784 (add-hook 'muse-after-project-publish-hook
785 'planner-authz-after-project-publish
)
787 (let ((styles (list "html" "xhtml")))
789 (let ((style (concat "planner-authz-mason-" (car styles
))))
790 (unless (assoc style muse-publishing-styles
)
792 style
(concat "planner-" (car styles
))
793 :before
'planner-authz-before-markup
794 :after
'planner-authz-after-markup
795 :functions
'planner-authz-markup-functions
796 :regexps
'planner-authz-markup-regexps
797 :strings
'planner-authz-mason-markup-strings
798 :tags
(append planner-authz-markup-tags
799 planner-publish-markup-tags
))))
800 (setq styles
(cdr styles
))))
802 (provide 'planner-authz
)
804 ;;; planner-authz.el ends here