Docfix and remove one redundant LOC.
[planner-el.git] / planner-authz.el
blob366a180eed36aebcd26a53b7e5d1932ad06fe453
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
12 ;; URL:
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)
20 ;; any later version.
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.
32 ;;; Commentary:
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.
58 ;; * Diary Markup
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)
76 ;; * Startup
78 ;; Add the following to your .emacs file to cause
79 ;; M-x muse-project-publish to automatically use planner-authz
80 ;; features.
82 ;; (require 'planner-authz)
84 ;; * Customization
86 ;; All user-serviceable options can be customized with
87 ;; M-x customize-group RET planner-authz RET.
89 ;; * Defaults
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.
116 ;;; Todo
118 ;; - Make more specific tags override less specific ones, rather than
119 ;; more restrictive overriding less restrictive
121 ;;; Code
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."
130 :group 'planner
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
137 :type 'hook)
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 "\\|&nbsp;\\)\\(?:[ \t|]+\\(?:" planner-appt-time-regexp
162 "\\|&nbsp;\\)\\)?[ \t|]+"))
163 "Regexp that matches a `planner-appt' start and end time specification."
164 :group 'planner-authz
165 :type 'string)
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
185 :type '(string))
187 (defcustom planner-authz-mason-component-contents
188 "<%once>
189 sub authz {
190 my $r_user = $r ? $r->connection->user
191 : $ENV{REMOTE_USER} or return 0;
192 foreach (@_) { return 1 if $r_user eq $_ }
193 return 0;
195 </%once>
196 <%method content>
197 <%args>
198 $alt => undef
199 @users
200 </%args>
201 % if (authz @users) {
202 <% $m->content %>\\
203 % } elsif ($alt) {
204 <% $alt %>\\
206 </%method>
207 <%method page>
208 <%args>@users</%args>
209 <%perl>
210 unless (authz @users) {
211 $m->clear_buffer;
212 $m->abort(404);
214 </%perl>
215 </%method>
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
221 :type 'string)
223 (defcustom planner-authz-mason-component-name "authz.mas"
224 "Name of Mason component that restricts content."
225 :group 'planner-authz
226 :type 'string)
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
234 the linked pages.
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
259 :type '(string))
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
270 USER-LIST only.
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))
282 (repeat string)))
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"
292 integer
293 (choice regexp symbol)
294 integer
295 (choice string function symbol))
296 function)))
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)
315 function)))
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
326 searched."
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
343 changed.")
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
349 recursion.")
351 ;;; Functions
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)))
357 (when page
359 (let ((cell (assoc page planner-authz-publishing-alist)))
360 (if cell
362 ;; if already t, the list is stale; whack it
363 (if (cdr cell)
364 (setq planner-authz-publishing-alist '(page . t)))
366 (push '(page . t) planner-authz-publishing-alist)))
368 (let ((users (planner-authz-users)))
369 (when users
370 (goto-char (point-min))
371 (planner-insert-markup (muse-markup-text 'planner-authz-page users))
372 (insert "\n"))))))
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)
382 planner-project t)))
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."
395 (save-match-data
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))
408 result)
409 (while pages
410 (let (not-found-p)
411 (with-temp-buffer
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)))))
420 (unless not-found-p
421 (setq result (append (list (car pages)) result))))
422 (setq pages (cdr pages))))
423 result))
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
437 #authz tags."
438 (with-temp-buffer
439 (insert planner-authz-mason-component-contents)
440 (let ((backup-inhibited t)
441 (styles (cddr project)))
442 (while styles
443 (let ((path (muse-style-element :path (car styles))))
444 (and path
445 (string-match "mason" (muse-style-element :base (car styles)))
446 (write-file
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)
455 (funcall predict)
456 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)
462 section-name
463 section-level
464 next-section-regexp)
465 (goto-char begin)
466 (save-match-data
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
471 (while rule-list
472 (if (string-match (caar rule-list) section-name)
473 (throw 'done (car rule-list))
474 (setq rule-list (cdr rule-list))))
475 nil)))
476 (if (and rule
477 (planner-authz-markup-section-predict rule))
478 (progn
479 (goto-char begin)
480 (muse-publish-surround-text
481 (format "<authz users=\"%s\">\n"
482 (mapconcat 'identity (elt rule 2) " "))
483 "\n</authz>\n"
484 (lambda ()
485 (save-match-data
486 (let ((found nil))
487 (re-search-forward planner-authz-sections-regexp nil t)
488 (while (and (not found)
489 (re-search-forward planner-authz-sections-regexp
490 nil t))
491 (if (<= (length (match-string 1))
492 section-level)
493 (setq found t)))
494 (if found
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)))
508 (base (if style
509 (muse-style-element :base style)))
510 (func (if base
511 (muse-find-markup-element
512 :functions 'table (muse-style-element :base base)))))
513 (when (functionp func)
514 (save-excursion
515 (save-match-data
516 (goto-char beg)
517 (while (search-forward "<&|" (line-end-position) t)
518 (replace-match "<&:" t t))))
519 (funcall func)
520 (let ((end (point)))
521 (goto-char beg)
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."
533 (with-temp-buffer
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
538 (if as-list
539 (concat "^[" muse-regexp-blank "]+-["
540 muse-regexp-blank "]*")
541 (concat "^[" muse-regexp-blank "]*"))
542 nil t)
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))))
547 (if users
548 (progn
549 (insert (format "<authz users=\"%s\">" users))
550 (end-of-line)
551 (insert "</authz>"))
552 (end-of-line)))))
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
558 restricted."
559 (and (not planner-authz-disable-dependency-publishing)
560 (planner-authz-users)
561 (while linked-pages
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
570 unauthorized users."
571 (save-excursion
572 (let ((alt (or (cdr (assoc "alt" attrs)) ""))
573 (users (or (cdr (assoc "users" attrs)) "")))
574 (goto-char beg)
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)))
579 (goto-char end)
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."
584 (save-excursion
585 (save-restriction
586 (narrow-to-region beg end)
587 (planner-publish-nested-section-tag beg end)
588 (goto-char beg)
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)
600 link))))
601 (linked-users
602 (if linked-pages
603 (planner-authz-multi-users linked-pages)
604 (and planner-authz-day-task-default
605 (mapconcat 'identity planner-authz-day-task-default
606 " ")))))
607 (when linked-users
608 (if (and planner-authz-appt-alt planner-authz-appt-regexp
609 (progn
610 (goto-char line-begin)
611 (re-search-forward
612 planner-authz-appt-regexp line-end t)))
613 (progn
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)))
620 (end-of-line)
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."
629 (save-excursion
630 (save-restriction
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))
636 categories))
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)
641 links))))
642 (linked-users
643 (if linked-pages
644 (planner-authz-multi-users linked-pages)
645 (and planner-authz-day-note-default
646 (planner-authz-day-p)
647 (mapconcat 'identity
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
654 (if linked-pages
655 (planner-authz-republish-dependencies-maybe linked-pages))
657 ;; If the linked page has an authz restriction, restrict this note
659 (when linked-users
660 (goto-char (point-min))
661 (planner-insert-markup
662 (muse-markup-text 'planner-authz-begin linked-users))
663 (insert "\n")
664 (goto-char (point-max))
665 (planner-insert-markup (muse-markup-text 'planner-authz-end))
666 (insert "\n"))))))
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."
673 (save-excursion
674 (save-restriction
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)
682 link))))
683 (linked-users
684 (if linked-pages
685 (planner-authz-multi-users linked-pages)
686 (and planner-authz-day-task-default
687 (planner-authz-day-p)
688 (mapconcat 'identity
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
695 (if linked-pages
696 (planner-authz-republish-dependencies-maybe linked-pages))
698 ;; If the linked page has an authz restriction, restrict this task
700 (when linked-users
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
716 current page."
717 (unless page (setq page (planner-page-name)))
718 (let ((match (cdr (assoc page planner-authz-pages))))
719 (unless match
720 (let ((file (cdr (assoc page (planner-file-alist)))))
721 (setq match
722 (or (and file
723 (with-temp-buffer
724 (insert-file-contents-literally file)
725 (if (re-search-forward "^#authz\\s-+\\(.+\\)\n+"
726 nil t)
727 (match-string 1))))
728 (planner-authz-default page))))
729 (push `(,page . ,match) planner-authz-pages))
730 match))
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
738 (while list
739 (setq sublist (car list))
740 (while sublist
741 (let ((entry (assoc (car sublist) alist)))
742 (if entry
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
749 (while alist
750 (if (= (cdar alist) count)
751 (setq intersection (cons (caar alist) intersection)))
752 (setq alist (cdr alist)))
753 intersection))
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."
757 (let (sublist union)
758 (while list
759 (setq sublist (car list))
760 (while sublist
761 (add-to-list 'union (car sublist))
762 (setq sublist (cdr sublist)))
763 (setq list (cdr list)))
764 union))
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."
773 (let ((users
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)))
778 (if users
779 (split-string users)))))
780 pages))))
781 (if 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")))
788 (while styles
789 (let ((style (concat "planner-authz-mason-" (car styles))))
790 (unless (assoc style muse-publishing-styles)
791 (muse-derive-style
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