planner-publish: Change :after to :before-end
[planner-el.git] / planner-authz.el
bloba29ddce11c03db42ec60f3e213918ee15269cf39
1 ;;; planner-authz.el --- restrict portions of published pages
3 ;; Copyright (C) 2004, 2005, 2006 Andrew J. Korty <ajk@iu.edu>
4 ;; Parts copyright (C) 2004, 2005 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: Emacs21
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 2, 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 (if (featurep 'muse-nested-tags)
306 '(("authz" t t nil planner-authz-tag)
307 ("diary-section" t t nil planner-authz-diary-section-tag)
308 ("note" t t nil planner-authz-note-tag)
309 ("task" t t nil planner-authz-task-tag))
310 '(("authz" t t planner-authz-tag)
311 ("diary-section" t t planner-authz-diary-section-tag)
312 ("note" t t planner-authz-note-tag)
313 ("task" t t planner-authz-task-tag)))
314 "A list of tag specifications for authorization markup."
315 :group 'planner-authz
316 :type '(repeat (list (string :tag "Markup tag")
317 (boolean :tag "Expect closing tag" :value t)
318 (boolean :tag "Parse attributes" :value nil)
319 (boolean :tag "Nestable" :value nil)
320 function)))
322 (defcustom planner-authz-mason-markup-strings
323 '((planner-authz-begin . "<&| authz.mas:content, 'users', [qw(%s)] &>")
324 (planner-authz-begin-alt
325 . "<&| authz.mas:content, 'users', [qw(%s)], 'alt', '%s' &>")
326 (planner-authz-end . "</&>")
327 (planner-authz-page . "<& authz.mas:page, 'users', [qw(%s)] &>"))
328 "Strings used for additing authorization controls.
330 If a markup rule is not found here, `planner-html-markup-strings' is
331 searched."
332 :type '(alist :key-type symbol :value-type string)
333 :group 'planner-authz)
335 ;; Non-customizable variables
337 (defvar planner-authz-pages nil
338 "Alist of planner pages and users authorized to view them.
339 The list of users is separated by spaces. This variable is
340 internal to planner-authz; do not set it manually.")
341 (defvar planner-authz-publishing-alist nil
342 "Alist used by `planner-authz' to track published pages and their dependencies.
343 This alist stores pages that have been published during the current
344 publishing process, as (PAGENAME . t), and pages whose tasks and notes
345 depend on those pages for access control, as (PAGENAME . nil). At the
346 end of publishing, `planner-authz' uses this alist to determine which
347 dependencies need to be republished, even if they themselves haven't
348 changed.")
349 (defvar planner-authz-disable-dependency-publishing nil
350 "If non-nil, `planner-authz' will not republish unchanged pages whose tasks or notes depend on the page currently being published.
351 Normally, linked pages are republished in case the access list for the
352 current page has changed. This variable is set to t while
353 `planner-authz' is republishing dependent pages to avoid indefinite
354 recursion.")
356 ;;; Functions
358 (defun planner-authz-after-markup ()
359 "Remove the page currently being marked up from the queue of pages
360 to republish and enforce default access controls for project pages."
361 (let ((page (planner-page-name)))
362 (when page
364 (let ((cell (assoc page planner-authz-publishing-alist)))
365 (if cell
367 ;; if already t, the list is stale; whack it
368 (if (cdr cell)
369 (setq planner-authz-publishing-alist '(page . t)))
371 (push '(page . t) planner-authz-publishing-alist)))
373 (let ((users (planner-authz-users)))
374 (when users
375 (goto-char (point-min))
376 (planner-insert-markup (muse-markup-text 'planner-authz-page users))
377 (insert "\n"))))))
379 (defun planner-authz-after-project-publish (project)
380 "Republish pages that reference restricted pages and call the
381 generate Mason code."
382 (when (string= planner-project (car project))
383 (while planner-authz-publishing-alist
384 (if (not (cdar planner-authz-publishing-alist))
385 (let ((planner-authz-disable-dependency-publishing t))
386 (muse-project-publish-file (caar planner-authz-publishing-alist)
387 planner-project t)))
388 (setq planner-authz-publishing-alist
389 (cdr planner-authz-publishing-alist)))
390 (run-hook-with-args 'planner-authz-after-publish-hook project)))
392 (defun planner-authz-before-markup ()
393 "Process #authz directives when publishing only a single page. Mark
394 planner page sections according to
395 `planner-authz-sections-rule-list'."
396 (planner-authz-markup-all-sections))
398 (defun planner-authz-day-p (&optional page)
399 "Return non-nil if the current page or PAGE is a day page."
400 (save-match-data
401 (string-match planner-date-regexp (or page (planner-page-name)))))
403 (defun planner-authz-default (page)
404 "Return the default space-separated string of users that would apply
405 to PAGE. Nil is always returned for day pages."
406 (and planner-authz-project-default
407 (not (planner-authz-day-p page)) ; not on day pages
408 (mapconcat 'identity planner-authz-project-default " ")))
410 (defun planner-authz-file-alist (users)
411 "Generate a list of planner files that USERS have access to."
412 (let ((pages (planner-file-alist))
413 result)
414 (while pages
415 (let (not-found-p)
416 (with-temp-buffer
417 (insert-file-contents-literally (cdar pages))
418 (when (re-search-forward "^#authz\\s-+\\(.+\\)\n+" nil t)
419 (let ((users-iter users)
420 (authz (split-string (match-string 1))))
421 (while (and users-iter (not not-found-p))
422 (unless (member (car users-iter) authz)
423 (setq not-found-p t))
424 (setq users-iter (cdr users-iter)))))
425 (unless not-found-p
426 (setq result (append (list (car pages)) result))))
427 (setq pages (cdr pages))))
428 result))
430 (defun planner-authz-fix-list-item ()
431 "Rearrange list items restricted by `planner-authz' to avoid empty list items on the published page."
432 (replace-match "\\2\\1\\3\\5\\4")
433 (muse-publish-mark-read-only (match-beginning 0) (match-end 2))
434 (muse-publish-mark-read-only (match-beginning 4) (match-end 0)))
436 (defun planner-authz-generate-mason-component (project)
437 "Generate the Mason component restricting content.
438 The component's name is taken from
439 `planner-authz-mason-component-name' and initialized with the
440 contents of `planner-authz-mason-component-contents'. The
441 component restricts access to users specified by <authz> and
442 #authz tags."
443 (with-temp-buffer
444 (insert planner-authz-mason-component-contents)
445 (let ((backup-inhibited t)
446 (styles (cddr project)))
447 (while styles
448 (let ((path (muse-style-element :path (car styles))))
449 (and path
450 (string-match "mason" (muse-style-element :base (car styles)))
451 (write-file
452 (concat (file-name-directory path)
453 planner-authz-mason-component-name))))
454 (setq styles (cdr styles))))))
456 (defun planner-authz-markup-section-predict (rule)
457 "Check if the prediction is satisfied."
458 (let ((predict (elt rule 1)))
459 (if (functionp predict)
460 (funcall predict)
461 predict)))
463 (defun planner-authz-markup-section ()
464 "Restrict section according to `planner-authz-sections-rule-list'."
465 (let ((begin (planner-line-beginning-position))
466 (rule-list planner-authz-sections-rule-list)
467 section-name
468 section-level
469 next-section-regexp)
470 (goto-char begin)
471 (save-match-data
472 (re-search-forward planner-authz-sections-regexp nil t)
473 (setq section-level (length (match-string 1)))
474 (setq section-name (match-string 2)))
475 (let ((rule (catch 'done
476 (while rule-list
477 (if (string-match (caar rule-list) section-name)
478 (throw 'done (car rule-list))
479 (setq rule-list (cdr rule-list))))
480 nil)))
481 (if (and rule
482 (planner-authz-markup-section-predict rule))
483 (progn
484 (goto-char begin)
485 (muse-publish-surround-text
486 (format "<authz users=\"%s\">\n"
487 (mapconcat 'identity (elt rule 2) " "))
488 "\n</authz>\n"
489 (lambda ()
490 (save-match-data
491 (let ((found nil))
492 (re-search-forward planner-authz-sections-regexp nil t)
493 (while (and (not found)
494 (re-search-forward planner-authz-sections-regexp
495 nil t))
496 (if (<= (length (match-string 1))
497 section-level)
498 (setq found t)))
499 (if found
500 (goto-char (planner-line-beginning-position))
501 (goto-char (point-max))))))))))))
503 (defun planner-authz-markup-all-sections ()
504 "Run `planner-authz-markup-section' on the entire buffer."
505 (goto-char (point-min))
506 (while (re-search-forward planner-authz-sections-regexp nil t)
507 (planner-authz-markup-section)))
509 (defun planner-authz-mason-markup-table ()
510 "Protect \"<&|\" Mason constructs from Muse table markup."
511 (let* ((beg (planner-line-beginning-position))
512 (style (muse-style-element :base (muse-style)))
513 (base (if style
514 (muse-style-element :base style)))
515 (func (if base
516 (muse-find-markup-element
517 :functions 'table (muse-style-element :base base)))))
518 (when (functionp func)
519 (save-excursion
520 (save-match-data
521 (goto-char beg)
522 (while (search-forward "<&|" (line-end-position) t)
523 (replace-match "<&:" t t))))
524 (funcall func)
525 (let ((end (point)))
526 (goto-char beg)
527 (while (search-forward "<&:" end t)
528 (replace-match "<&|" t t))))))
531 (defun planner-authz-index-as-string (&optional as-list exclude-private)
532 "Generate an index of all Muse pages with authorization controls.
533 In the published index, only those links to pages which the remote
534 user is authorized to access will be shown.
535 If AS-LIST is non-nil, insert a dash and spaces before each item.
536 If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions.
537 If EXCLUDE-CURRENT is non-nil, exclude the current file from the output."
538 (with-temp-buffer
539 (insert (planner-index-as-string as-list exclude-private))
540 (when muse-publishing-p
541 (goto-char (point-min))
542 (while (and (re-search-forward
543 (if as-list
544 (concat "^[" muse-regexp-blank "]+-["
545 muse-regexp-blank "]*")
546 (concat "^[" muse-regexp-blank "]*"))
547 nil t)
548 (looking-at muse-explicit-link-regexp))
549 (let* ((link (buffer-substring (point) (line-end-position)))
550 (page (planner-link-base link))
551 (users (if page (planner-authz-users page))))
552 (if users
553 (progn
554 (insert (format "<authz users=\"%s\">" users))
555 (end-of-line)
556 (insert "</authz>"))
557 (end-of-line)))))
558 (buffer-substring (point-min) (point-max))))
560 (defun planner-authz-republish-dependencies-maybe (linked-pages)
561 "Remember LINKED-PAGES to be republished later.
562 The pages will be republished if and only if the current page is
563 restricted."
564 (and (not planner-authz-disable-dependency-publishing)
565 (planner-authz-users)
566 (while linked-pages
567 (unless (assoc (car linked-pages) planner-authz-publishing-alist)
568 (push '(car linked-pages) planner-authz-publishing-alist))
569 (setq linked-pages (cdr linked-pages)))))
571 (defun planner-authz-tag (beg end attrs)
572 "Publish <authz> tags. The region from BEG to END is protected.
573 ATTRS should be an alist of tag attributes including \"users\" and
574 optionally \"alt\" for alternative text to be displayed to
575 unauthorized users."
576 (save-excursion
577 (let ((alt (or (cdr (assoc "alt" attrs)) ""))
578 (users (or (cdr (assoc "users" attrs)) "")))
579 (goto-char beg)
580 (planner-insert-markup
581 (if (zerop (length alt))
582 (muse-markup-text 'planner-authz-begin users)
583 (muse-markup-text 'planner-authz-begin-alt users alt)))
584 (goto-char end)
585 (planner-insert-markup (muse-markup-text 'planner-authz-end)))))
587 (defun planner-authz-diary-section-tag (beg end attrs)
588 "Restrict entries in a diary section."
589 (save-excursion
590 (save-restriction
591 (narrow-to-region beg end)
592 (planner-publish-nested-section-tag beg end)
593 (goto-char beg)
594 (while (and (zerop (forward-line))
595 (= (point) (planner-line-beginning-position)))
596 (unless (looking-at "^\\(?:[ \t]*\\|No entries\\|</div>\\)$")
597 (let ((line-begin (point))
598 (line-end (line-end-position)))
599 (re-search-forward planner-authz-link-regexp line-end t)
600 (let* ((link (match-string 1))
601 (linked-pages (if link
602 (mapcar 'planner-link-base
603 (if (featurep 'planner-multi)
604 (planner-multi-split link)
605 link))))
606 (linked-users
607 (if linked-pages
608 (planner-authz-multi-users linked-pages)
609 (and planner-authz-day-task-default
610 (mapconcat 'identity planner-authz-day-task-default
611 " ")))))
612 (when linked-users
613 (if (and planner-authz-appt-alt planner-authz-appt-regexp
614 (progn
615 (goto-char line-begin)
616 (re-search-forward
617 planner-authz-appt-regexp line-end t)))
618 (progn
619 (search-forward " - " (+ 2 (point)) t)
620 (planner-insert-markup
621 (muse-markup-text 'planner-authz-begin-alt linked-users
622 planner-authz-appt-alt)))
623 (planner-insert-markup
624 (muse-markup-text 'planner-authz-begin linked-users)))
625 (end-of-line)
626 (planner-insert-markup
627 (muse-markup-text 'planner-authz-end))))))))))
629 (defun planner-authz-note-tag (beg end attrs)
630 "Restrict notes linked to a restricted page. If this page is
631 restricted and the note is linked to another page, remember to
632 republish that page later and restrict the note as it appears there.
633 Call `planner-publish-note-tag' as a side effect."
634 (save-excursion
635 (save-restriction
636 (narrow-to-region beg end)
637 (planner-publish-note-tag beg end attrs)
638 (let* ((categories (cdr (assoc "categories" attrs)))
639 (links (if (or (not categories) (zerop (length categories)))
640 (cdr (assoc "link" attrs))
641 categories))
642 (linked-pages (if (and links (not (zerop (length links))))
643 (mapcar 'planner-link-base
644 (if (featurep 'planner-multi)
645 (planner-multi-split links)
646 links))))
647 (linked-users
648 (if linked-pages
649 (planner-authz-multi-users linked-pages)
650 (and planner-authz-day-note-default
651 (planner-authz-day-p)
652 (mapconcat 'identity
653 planner-authz-day-note-default " ")))))
655 ;; If this note is linked to another page, republish that page
656 ;; later to restrict the note as it appears there, providing that
657 ;; page has an authz restriction
659 (if linked-pages
660 (planner-authz-republish-dependencies-maybe linked-pages))
662 ;; If the linked page has an authz restriction, restrict this note
664 (when linked-users
665 (goto-char (point-min))
666 (planner-insert-markup
667 (muse-markup-text 'planner-authz-begin linked-users))
668 (insert "\n")
669 (goto-char (point-max))
670 (planner-insert-markup (muse-markup-text 'planner-authz-end))
671 (insert "\n"))))))
673 (defun planner-authz-task-tag (beg end attrs)
674 "Restrict tasks linked to restricted pages. If this page is
675 restricted and the task is linked to another page, remember to
676 republish that page later and restrict the task as it appears there.
677 Call `planner-publish-task-tag' as a side effect."
678 (save-excursion
679 (save-restriction
680 (narrow-to-region beg end)
681 (planner-publish-task-tag beg end attrs)
682 (let* ((link (cdr (assoc "link" attrs)))
683 (linked-pages (if link
684 (mapcar 'planner-link-base
685 (if (featurep 'planner-multi)
686 (planner-multi-split link)
687 link))))
688 (linked-users
689 (if linked-pages
690 (planner-authz-multi-users linked-pages)
691 (and planner-authz-day-task-default
692 (planner-authz-day-p)
693 (mapconcat 'identity
694 planner-authz-day-task-default " ")))))
696 ;; If this task is linked to another page, republish that page
697 ;; later to restrict the task as it appears there, providing that
698 ;; page has an authz restriction
700 (if linked-pages
701 (planner-authz-republish-dependencies-maybe linked-pages))
703 ;; If the linked page has an authz restriction, restrict this task
705 (when linked-users
706 (goto-char (point-min))
707 (planner-insert-markup
708 (muse-markup-text 'planner-authz-begin linked-users))
709 (goto-char (point-max))
710 (planner-insert-markup (muse-markup-text 'planner-authz-end)))))))
712 (defun planner-authz-users (&optional page)
713 "Return a list of acceptable users for PAGE.
714 The list of users is returned as space-separated string, based on
715 a #authz directive appearing in the page. If PAGE contains no
716 #authz directive and is a project page (it doesn't match
717 `planner-date-regexp'), return `planner-authz-project-default' as
718 a space-separated string.
720 If PAGE is nil, return a list of users associated with the
721 current page."
722 (unless page (setq page (planner-page-name)))
723 (let ((match (cdr (assoc page planner-authz-pages))))
724 (unless match
725 (let ((file (cdr (assoc page (planner-file-alist)))))
726 (setq match
727 (or (and file
728 (with-temp-buffer
729 (insert-file-contents-literally file)
730 (if (re-search-forward "^#authz\\s-+\\(.+\\)\n+"
731 nil t)
732 (match-string 1))))
733 (planner-authz-default page))))
734 (push `(,page . ,match) planner-authz-pages))
735 match))
737 (defun planner-authz-multi-intersection (list)
738 "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."
739 (let ((count (length list))
740 alist intersection sublist)
742 ;; in alist, associate each name with its frequency of appearance
743 (while list
744 (setq sublist (car list))
745 (while sublist
746 (let ((entry (assoc (car sublist) alist)))
747 (if entry
748 (setcdr entry (1+ (cdr entry)))
749 (setq alist (cons `(,(car sublist) . 1) alist))))
750 (setq sublist (cdr sublist)))
751 (setq list (cdr list)))
753 ;; those names with `count' frequencies were in every sublist
754 (while alist
755 (if (= (cdar alist) count)
756 (setq intersection (cons (caar alist) intersection)))
757 (setq alist (cdr alist)))
758 intersection))
760 (defun planner-authz-multi-union (list)
761 "Merge a list of `planner-authz' access lists, returning a list of all the unique user names in any of those access lists."
762 (let (sublist union)
763 (while list
764 (setq sublist (car list))
765 (while sublist
766 (add-to-list 'union (car sublist))
767 (setq sublist (cdr sublist)))
768 (setq list (cdr list)))
769 union))
771 (defun planner-authz-multi-users (pages)
772 "Return a merged access list for PAGES.
773 The list of users is returned as space-separated string, based on a
774 #authz directive appearing in the PAGES. If one of PAGES contains no
775 #authz directive and is a project page (it doesn't match
776 `planner-date-regexp'), it will contribute
777 `planner-authz-project-default' to the merge."
778 (let ((users
779 (funcall planner-authz-multi-func
780 (mapcar (lambda (page)
781 (if (not (planner-authz-day-p page))
782 (let ((users (planner-authz-users page)))
783 (if users
784 (split-string users)))))
785 pages))))
786 (if users
787 (mapconcat 'identity users " "))))
789 (add-hook 'muse-after-project-publish-hook
790 'planner-authz-after-project-publish)
792 (let ((styles (list "html" "xhtml")))
793 (while styles
794 (let ((style (concat "planner-authz-mason-" (car styles))))
795 (unless (assoc style muse-publishing-styles)
796 (muse-derive-style
797 style (concat "planner-" (car styles))
798 :before 'planner-authz-before-markup
799 :after 'planner-authz-after-markup
800 :functions 'planner-authz-markup-functions
801 :regexps 'planner-authz-markup-regexps
802 :strings 'planner-authz-mason-markup-strings
803 :tags (append planner-authz-markup-tags
804 planner-publish-markup-tags))))
805 (setq styles (cdr styles))))
807 (provide 'planner-authz)
809 ;;; planner-authz.el ends here