blob: 168badb8d9abd3bf56cf2f364fb620e4675f07c0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
;;;; This file is part of Smap.
;;;; Copyright (C) 2010, 2014 Sergey Poznyakoff
;;;;
;;;; Smap 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.
;;;;
;;;; Smap 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 Smap. If not, see <http://www.gnu.org/licenses/>.
;;;; This script is a sample Guile module for smapd. It implements two
;;;; maps:
;;;; user NAME - return the passwd entry for NAME
;;;; groups NAME - return the list of group names for the user NAME.
(use-modules (srfi srfi-1))
;;; This function is called after by the smap subprocess before
;;; entering main loop.
(define (smap-open dbname . rest)
;; Everything you write to the standard error port is sent to the
;; smapd error output.
(format (current-error-port) "smap-open called; dbname=~A, arguments: ~A~%"
dbname rest)
#t)
;;; This function is called after by the smap subprocess after
;;; exiting from the event loop, and before terminating.
(define (smap-close handle)
(format (current-error-port) "smap-close called~%"))
(define (query-user name)
(let ((pw (getpwnam name)))
(string-append
"OK "
(passwd:name pw)
":"
(passwd:passwd pw)
":"
(number->string (passwd:uid pw))
":"
(number->string (passwd:gid pw))
":"
(passwd:gecos pw)
":"
(passwd:dir pw)
":"
(passwd:shell pw))))
(define (query-groups name)
(setgrent)
(fold
(lambda (elem prev)
(string-append prev " " elem))
"OK"
(let loop ((gl (list (group:name (getgrnam (passwd:gid (getpwnam name))))))
(gr (getgrent)))
(cond
(gr
(loop (if (member name (group:mem gr))
(cons (group:name gr) gl)
gl)
(getgrent)))
(else
(endgrent)
gl)))))
(define map-list
(list
(cons "user" query-user)
(cons "groups" query-groups)))
;;; Smap-query is called to handle each query. Arguments are:
;;; handle - database handle returned by smap_open
;;; map - the map name
;;; arg - query arguments
;;; rest - connection information
(define-public (smap-query handle map arg . rest)
;; Log the connection
(let ((src (car rest)))
(format (current-error-port) "connect from ~A~%"
(if (= (sockaddr:fam src) AF_INET)
(inet-ntoa (sockaddr:addr src))
"UNIX socket")))
;; Select appropriate handler and call it
(let ((elt (assoc map map-list)))
;; Whatever you write to the current output port, is buffered until
;; the newline character, then converted into a proper `sockmap'
;; protocol packet and sent back to the client as a reply.
(display
(cond
(elt
(catch 'misc-error
(lambda ()
((cdr elt) arg))
(lambda args
"NOTFOUND")))
(else
(format (current-error-port) "unknown map name: ~A~%" map)
"NOTFOUND")))
(newline)))
(define-public (smap-xform handle arg . rest)
(let ((arg-parts (string-split arg #\@)))
(if (null? (cdr arg-parts))
#f
(car arg-parts))))
;;; Module initialization function returns an associative list
;;; of methods implemented by the module. Each method is represented
;;; by a cons.
(define (init dbname)
(list
(cons "query" smap-query)
(cons "xform" smap-xform)
(cons "open" smap-open)
(cons "close" smap-close)))
;;;; End of getpw.scm
|