mail.scm 165 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
  3. ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
  4. ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
  5. ;;; Copyright © 2017, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
  6. ;;; Copyright © 2019 Kristofer Buffington <kristoferbuffington@gmail.com>
  7. ;;; Copyright © 2020 Jonathan Brielmaier <jonathan.brielmaier@web.de>
  8. ;;;
  9. ;;; This file is part of GNU Guix.
  10. ;;;
  11. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12. ;;; under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation; either version 3 of the License, or (at
  14. ;;; your option) any later version.
  15. ;;;
  16. ;;; GNU Guix is distributed in the hope that it will be useful, but
  17. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; You should have received a copy of the GNU General Public License
  22. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  23. ;;;
  24. ;;; Some of the help text was taken from the default dovecot.conf files.
  25. (define-module (gnu services mail)
  26. #:use-module (gnu services)
  27. #:use-module (gnu services base)
  28. #:use-module (gnu services configuration)
  29. #:use-module (gnu services shepherd)
  30. #:use-module (gnu system pam)
  31. #:use-module (gnu system shadow)
  32. #:use-module (gnu system setuid)
  33. #:use-module (gnu packages mail)
  34. #:use-module (gnu packages admin)
  35. #:use-module (gnu packages dav)
  36. #:use-module (gnu packages tls)
  37. #:use-module (guix records)
  38. #:use-module (guix packages)
  39. #:use-module (guix gexp)
  40. #:use-module (ice-9 match)
  41. #:use-module (ice-9 format)
  42. #:use-module (srfi srfi-1)
  43. #:export (dovecot-service
  44. dovecot-service-type
  45. dovecot-configuration
  46. opaque-dovecot-configuration
  47. dict-configuration
  48. passdb-configuration
  49. userdb-configuration
  50. unix-listener-configuration
  51. fifo-listener-configuration
  52. inet-listener-configuration
  53. service-configuration
  54. protocol-configuration
  55. plugin-configuration
  56. mailbox-configuration
  57. namespace-configuration
  58. opensmtpd-table
  59. opensmtpd-table?
  60. opensmtpd-table-name
  61. opensmtpd-table-data
  62. opensmtpd-ca
  63. opensmtpd-ca?
  64. opensmtpd-ca-name
  65. opensmtpd-ca-file
  66. opensmtpd-pki
  67. opensmtpd-pki?
  68. opensmtpd-pki-domain
  69. opensmtpd-pki-cert
  70. opensmtpd-pki-key
  71. opensmtpd-pki-dhe
  72. opensmtpd-local-delivery
  73. opensmtpd-local-delivery?
  74. opensmtpd-local-delivery-method
  75. opensmtpd-local-delivery-alias
  76. opensmtpd-local-delivery-ttl
  77. opensmtpd-local-delivery-user
  78. opensmtpd-local-delivery-userbase
  79. opensmtpd-local-delivery-virtual
  80. opensmtpd-local-delivery-wrapper
  81. opensmtpd-maildir
  82. opensmtpd-maildir?
  83. opensmtpd-maildir-pathname
  84. opensmtpd-maildir-junk
  85. opensmtpd-mda
  86. opensmtpd-mda-name
  87. opensmtpd-mda-command
  88. opensmtpd-lmtp
  89. opensmtpd-lmtp-destination
  90. opensmtpd-lmtp-rcpt
  91. opensmtpd-relay
  92. opensmtpd-relay?
  93. opensmtpd-relay-name
  94. opensmtpd-relay-backup
  95. opensmtpd-relay-backup-mx
  96. opensmtpd-relay-helo
  97. opensmtpd-relay-domain
  98. opensmtpd-relay-host
  99. opensmtpd-relay-pki
  100. opensmtpd-relay-srs
  101. opensmtpd-relay-tls
  102. opensmtpd-relay-auth
  103. opensmtpd-relay-mail-from
  104. opensmtpd-relay-src
  105. opensmtpd-option
  106. opensmtpd-option?
  107. opensmtpd-option-option
  108. opensmtpd-option-not
  109. opensmtpd-option-regex
  110. opensmtpd-option-data
  111. opensmtpd-filter-phase
  112. opensmtpd-filter-phase?
  113. opensmtpd-filter-phase-name
  114. opensmtpd-filter-phase-phase
  115. opensmtpd-filter-phase-options
  116. opensmtpd-filter-phase-decision
  117. opensmtpd-filter-phase-message
  118. opensmtpd-filter-phase-value
  119. opensmtpd-filter
  120. opensmtpd-filter?
  121. opensmtpd-filter-name
  122. opensmtpd-filter-proc
  123. opensmtpd-interface
  124. opensmtpd-interface?
  125. opensmtpd-interface-interface
  126. opensmtpd-interface-family
  127. opensmtpd-interface-auth
  128. opensmtpd-interface-auth-optional
  129. opensmtpd-interface-filters
  130. opensmtpd-interface-hostname
  131. opensmtpd-interface-hostnames
  132. opensmtpd-interface-mask-src
  133. opensmtpd-interface-disable-dsn
  134. opensmtpd-interface-pki
  135. opensmtpd-interface-port
  136. opensmtpd-interface-proxy-v2
  137. opensmtpd-interface-received-auth
  138. opensmtpd-interface-senders
  139. opensmtpd-interface-secure-connection
  140. opensmtpd-interface-tag
  141. opensmtpd-socket
  142. opensmtpd-socket?
  143. opensmtpd-socket-filters
  144. opensmtpd-socket-mask-src
  145. opensmtpd-socket-tag
  146. opensmtpd-match
  147. opensmtpd-match?
  148. opensmtpd-match-action
  149. opensmtpd-match-options
  150. opensmtpd-smtp
  151. opensmtpd-smtp?
  152. opensmtpd-smtp-ciphers
  153. opensmtpd-smtp-limit-max-mails
  154. opensmtpd-smtp-limit-max-rcpt
  155. opensmtpd-smtp-max-message-size
  156. opensmtpd-smtp-sub-addr-delim character
  157. opensmtpd-srs
  158. opensmtpd-srs?
  159. opensmtpd-srs-key
  160. opensmtpd-srs-backup-key
  161. opensmtpd-srs-ttl-delay
  162. opensmtpd-queue
  163. opensmtpd-queue?
  164. opensmtpd-queue-compression
  165. opensmtpd-queue-encryption
  166. opensmtpd-queue-ttl-delay
  167. opensmtpd-configuration
  168. opensmtpd-configuration?
  169. opensmtpd-package
  170. opensmtpd-config-file
  171. opensmtpd-configuration-bounce
  172. opensmtpd-configuration-interfaces
  173. opensmtpd-configuration-socket
  174. opensmtpd-configuration-includes
  175. opensmtpd-configuration-matches
  176. opensmtpd-configuration-mda-wrappers
  177. opensmtpd-configuration-mta-max-deferred
  178. opensmtpd-configuration-srs
  179. opensmtpd-configuration-smtp
  180. opensmtpd-configuration-queue
  181. mail-aliases-service-type
  182. exim-configuration
  183. exim-configuration?
  184. exim-service-type
  185. %default-exim-config-file
  186. imap4d-configuration
  187. imap4d-configuration?
  188. imap4d-service-type
  189. %default-imap4d-config-file
  190. radicale-configuration
  191. radicale-configuration?
  192. radicale-service-type
  193. %default-radicale-config-file))
  194. ;;; Commentary:
  195. ;;;
  196. ;;; This module provides service definitions for the Dovecot POP3 and IMAP
  197. ;;; mail server.
  198. ;;;
  199. ;;; Code:
  200. (define (uglify-field-name field-name)
  201. (let ((str (symbol->string field-name)))
  202. (string-join (string-split (if (string-suffix? "?" str)
  203. (substring str 0 (1- (string-length str)))
  204. str)
  205. #\-)
  206. "_")))
  207. (define (serialize-field field-name val)
  208. (format #t "~a=~a\n" (uglify-field-name field-name) val))
  209. (define (serialize-string field-name val)
  210. (serialize-field field-name val))
  211. (define (space-separated-string-list? val)
  212. (and (list? val)
  213. (and-map (lambda (x)
  214. (and (string? x) (not (string-index x #\space))))
  215. val)))
  216. (define (serialize-space-separated-string-list field-name val)
  217. (match val
  218. (() #f)
  219. (_ (serialize-field field-name (string-join val " ")))))
  220. (define (comma-separated-string-list? val)
  221. (and (list? val)
  222. (and-map (lambda (x)
  223. (and (string? x) (not (string-index x #\,))))
  224. val)))
  225. (define (serialize-comma-separated-string-list field-name val)
  226. (serialize-field field-name (string-join val ",")))
  227. (define (file-name? val)
  228. (and (string? val)
  229. (string-prefix? "/" val)))
  230. (define (serialize-file-name field-name val)
  231. (serialize-string field-name val))
  232. (define (colon-separated-file-name-list? val)
  233. (and (list? val)
  234. ;; Trailing slashes not needed and not
  235. (and-map file-name? val)))
  236. (define (serialize-colon-separated-file-name-list field-name val)
  237. (serialize-field field-name (string-join val ":")))
  238. (define (serialize-boolean field-name val)
  239. (serialize-string field-name (if val "yes" "no")))
  240. (define (non-negative-integer? val)
  241. (and (exact-integer? val) (not (negative? val))))
  242. (define (serialize-non-negative-integer field-name val)
  243. (serialize-field field-name val))
  244. (define (hours? val) (non-negative-integer? val))
  245. (define (serialize-hours field-name val)
  246. (serialize-field field-name (format #f "~a hours" val)))
  247. (define (free-form-fields? val)
  248. (match val
  249. (() #t)
  250. ((((? symbol?) . (? string?)) . val) (free-form-fields? val))
  251. (_ #f)))
  252. (define (serialize-free-form-fields field-name val)
  253. (for-each (match-lambda ((k . v) (serialize-field k v))) val))
  254. (define (free-form-args? val)
  255. (match val
  256. (() #t)
  257. ((((? symbol?) . (? string?)) . val) (free-form-args? val))
  258. (_ #f)))
  259. (define (serialize-free-form-args field-name val)
  260. (serialize-field field-name
  261. (string-join
  262. (map (match-lambda ((k . v) (format #f "~a=~a" k v))) val)
  263. " ")))
  264. (define-configuration dict-configuration
  265. (entries
  266. (free-form-fields '())
  267. "A list of key-value pairs that this dict should hold."))
  268. (define (serialize-dict-configuration field-name val)
  269. (format #t "dict {\n")
  270. (serialize-configuration val dict-configuration-fields)
  271. (format #t "}\n"))
  272. (define-configuration passdb-configuration
  273. (driver
  274. (string "pam")
  275. "The driver that the passdb should use. Valid values include
  276. @samp{pam}, @samp{passwd}, @samp{shadow}, @samp{bsdauth}, and
  277. @samp{static}.")
  278. (args
  279. (space-separated-string-list '())
  280. "Space separated list of arguments to the passdb driver."))
  281. (define (serialize-passdb-configuration field-name val)
  282. (format #t "passdb {\n")
  283. (serialize-configuration val passdb-configuration-fields)
  284. (format #t "}\n"))
  285. (define (passdb-configuration-list? val)
  286. (and (list? val) (and-map passdb-configuration? val)))
  287. (define (serialize-passdb-configuration-list field-name val)
  288. (for-each (lambda (val) (serialize-passdb-configuration field-name val)) val))
  289. (define-configuration userdb-configuration
  290. (driver
  291. (string "passwd")
  292. "The driver that the userdb should use. Valid values include
  293. @samp{passwd} and @samp{static}.")
  294. (args
  295. (space-separated-string-list '())
  296. "Space separated list of arguments to the userdb driver.")
  297. (override-fields
  298. (free-form-args '())
  299. "Override fields from passwd."))
  300. (define (serialize-userdb-configuration field-name val)
  301. (format #t "userdb {\n")
  302. (serialize-configuration val userdb-configuration-fields)
  303. (format #t "}\n"))
  304. (define (userdb-configuration-list? val)
  305. (and (list? val) (and-map userdb-configuration? val)))
  306. (define (serialize-userdb-configuration-list field-name val)
  307. (for-each (lambda (val) (serialize-userdb-configuration field-name val)) val))
  308. (define-configuration unix-listener-configuration
  309. (path
  310. (string (configuration-missing-field 'unix-listener 'path))
  311. "Path to the file, relative to @code{base-dir} field. This is also used as
  312. the section name.")
  313. (mode
  314. (string "0600")
  315. "The access mode for the socket.")
  316. (user
  317. (string "")
  318. "The user to own the the socket.")
  319. (group
  320. (string "")
  321. "The group to own the socket."))
  322. (define (serialize-unix-listener-configuration field-name val)
  323. (format #t "unix_listener ~a {\n" (unix-listener-configuration-path val))
  324. (serialize-configuration val (cdr unix-listener-configuration-fields))
  325. (format #t "}\n"))
  326. (define-configuration fifo-listener-configuration
  327. (path
  328. (string (configuration-missing-field 'fifo-listener 'path))
  329. "Path to the file, relative to @code{base-dir} field. This is also used as
  330. the section name.")
  331. (mode
  332. (string "0600")
  333. "The access mode for the socket.")
  334. (user
  335. (string "")
  336. "The user to own the the socket.")
  337. (group
  338. (string "")
  339. "The group to own the socket."))
  340. (define (serialize-fifo-listener-configuration field-name val)
  341. (format #t "fifo_listener ~a {\n" (fifo-listener-configuration-path val))
  342. (serialize-configuration val (cdr fifo-listener-configuration-fields))
  343. (format #t "}\n"))
  344. (define-configuration inet-listener-configuration
  345. (protocol
  346. (string (configuration-missing-field 'inet-listener 'protocol))
  347. "The protocol to listen for.")
  348. (address
  349. (string "")
  350. "The address on which to listen, or empty for all addresses.")
  351. (port
  352. (non-negative-integer
  353. (configuration-missing-field 'inet-listener 'port))
  354. "The port on which to listen.")
  355. (ssl?
  356. (boolean #t)
  357. "Whether to use SSL for this service; @samp{yes}, @samp{no}, or
  358. @samp{required}."))
  359. (define (serialize-inet-listener-configuration field-name val)
  360. (format #t "inet_listener ~a {\n" (inet-listener-configuration-protocol val))
  361. (serialize-configuration val (cdr inet-listener-configuration-fields))
  362. (format #t "}\n"))
  363. (define (listener-configuration? val)
  364. (or (unix-listener-configuration? val)
  365. (fifo-listener-configuration? val)
  366. (inet-listener-configuration? val)))
  367. (define (serialize-listener-configuration field-name val)
  368. (cond
  369. ((unix-listener-configuration? val)
  370. (serialize-unix-listener-configuration field-name val))
  371. ((fifo-listener-configuration? val)
  372. (serialize-fifo-listener-configuration field-name val))
  373. ((inet-listener-configuration? val)
  374. (serialize-inet-listener-configuration field-name val))
  375. (else (configuration-field-error #f field-name val))))
  376. (define (listener-configuration-list? val)
  377. (and (list? val) (and-map listener-configuration? val)))
  378. (define (serialize-listener-configuration-list field-name val)
  379. (for-each (lambda (val)
  380. (serialize-listener-configuration field-name val))
  381. val))
  382. (define-configuration service-configuration
  383. (kind
  384. (string (configuration-missing-field 'service 'kind))
  385. "The service kind. Valid values include @code{director},
  386. @code{imap-login}, @code{pop3-login}, @code{lmtp}, @code{imap},
  387. @code{pop3}, @code{auth}, @code{auth-worker}, @code{dict},
  388. @code{tcpwrap}, @code{quota-warning}, or anything else.")
  389. (listeners
  390. (listener-configuration-list '())
  391. "Listeners for the service. A listener is either an
  392. @code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or
  393. an @code{inet-listener-configuration}.")
  394. (client-limit
  395. (non-negative-integer 0)
  396. "Maximum number of simultaneous client connections per process. Once this
  397. number of connections is received, the next incoming connection will prompt
  398. Dovecot to spawn another process. If set to 0, @code{default-client-limit} is
  399. used instead.")
  400. (service-count
  401. (non-negative-integer 1)
  402. "Number of connections to handle before starting a new process.
  403. Typically the only useful values are 0 (unlimited) or 1. 1 is more
  404. secure, but 0 is faster. <doc/wiki/LoginProcess.txt>.")
  405. (process-limit
  406. (non-negative-integer 0)
  407. "Maximum number of processes that can exist for this service. If set to 0,
  408. @code{default-process-limit} is used instead.")
  409. (process-min-avail
  410. (non-negative-integer 0)
  411. "Number of processes to always keep waiting for more connections.")
  412. ;; FIXME: Need to be able to take the default for this value from other
  413. ;; parts of the config.
  414. (vsz-limit
  415. (non-negative-integer #e256e6)
  416. "If you set @samp{service-count 0}, you probably need to grow
  417. this."))
  418. (define (serialize-service-configuration field-name val)
  419. (format #t "service ~a {\n" (service-configuration-kind val))
  420. (serialize-configuration val (cdr service-configuration-fields))
  421. (format #t "}\n"))
  422. (define (service-configuration-list? val)
  423. (and (list? val) (and-map service-configuration? val)))
  424. (define (serialize-service-configuration-list field-name val)
  425. (for-each (lambda (val)
  426. (serialize-service-configuration field-name val))
  427. val))
  428. (define-configuration protocol-configuration
  429. (name
  430. (string (configuration-missing-field 'protocol 'name))
  431. "The name of the protocol.")
  432. (auth-socket-path
  433. (string "/var/run/dovecot/auth-userdb")
  434. "UNIX socket path to master authentication server to find users.
  435. This is used by imap (for shared users) and lda.")
  436. (mail-plugins
  437. (space-separated-string-list '("$mail_plugins"))
  438. "Space separated list of plugins to load.")
  439. (mail-max-userip-connections
  440. (non-negative-integer 10)
  441. "Maximum number of IMAP connections allowed for a user from each IP
  442. address. NOTE: The username is compared case-sensitively.")
  443. (imap-metadata?
  444. (boolean #f)
  445. "Whether to enable the @code{IMAP METADATA} extension as defined in
  446. @uref{https://tools.ietf.org/html/rfc5464, RFC@tie{}5464}, which provides
  447. a means for clients to set and retrieve per-mailbox, per-user metadata
  448. and annotations over IMAP.
  449. If this is @samp{#t}, you must also specify a dictionary @i{via} the
  450. @code{mail-attribute-dict} setting.")
  451. (managesieve-notify-capability
  452. (space-separated-string-list '())
  453. "Which NOTIFY capabilities to report to clients that first connect to
  454. the ManageSieve service, before authentication. These may differ from the
  455. capabilities offered to authenticated users. If this field is left empty,
  456. report what the Sieve interpreter supports by default.")
  457. (managesieve-sieve-capability
  458. (space-separated-string-list '())
  459. "Which SIEVE capabilities to report to clients that first connect to
  460. the ManageSieve service, before authentication. These may differ from the
  461. capabilities offered to authenticated users. If this field is left empty,
  462. report what the Sieve interpreter supports by default."))
  463. (define (serialize-protocol-configuration field-name val)
  464. (format #t "protocol ~a {\n" (protocol-configuration-name val))
  465. (serialize-configuration val (cdr protocol-configuration-fields))
  466. (format #t "}\n"))
  467. (define (protocol-configuration-list? val)
  468. (and (list? val) (and-map protocol-configuration? val)))
  469. (define (serialize-protocol-configuration-list field-name val)
  470. (serialize-field 'protocols
  471. (string-join (map protocol-configuration-name val) " "))
  472. (for-each (lambda (val)
  473. (serialize-protocol-configuration field-name val))
  474. val))
  475. (define-configuration plugin-configuration
  476. (entries
  477. (free-form-fields '())
  478. "A list of key-value pairs that this dict should hold."))
  479. (define (serialize-plugin-configuration field-name val)
  480. (format #t "plugin {\n")
  481. (serialize-configuration val plugin-configuration-fields)
  482. (format #t "}\n"))
  483. (define-configuration mailbox-configuration
  484. (name
  485. (string (error "mailbox name is required"))
  486. "Name for this mailbox.")
  487. (auto
  488. (string "no")
  489. "@samp{create} will automatically create this mailbox.
  490. @samp{subscribe} will both create and subscribe to the mailbox.")
  491. (special-use
  492. (space-separated-string-list '())
  493. "List of IMAP @code{SPECIAL-USE} attributes as specified by RFC 6154.
  494. Valid values are @code{\\All}, @code{\\Archive}, @code{\\Drafts},
  495. @code{\\Flagged}, @code{\\Junk}, @code{\\Sent}, and @code{\\Trash}."))
  496. (define (serialize-mailbox-configuration field-name val)
  497. (format #t "mailbox \"~a\" {\n" (mailbox-configuration-name val))
  498. (serialize-configuration val (cdr mailbox-configuration-fields))
  499. (format #t "}\n"))
  500. (define (mailbox-configuration-list? val)
  501. (and (list? val) (and-map mailbox-configuration? val)))
  502. (define (serialize-mailbox-configuration-list field-name val)
  503. (for-each (lambda (val)
  504. (serialize-mailbox-configuration field-name val))
  505. val))
  506. (define-configuration namespace-configuration
  507. (name
  508. (string (error "namespace name is required"))
  509. "Name for this namespace.")
  510. (type
  511. (string "private")
  512. "Namespace type: @samp{private}, @samp{shared} or @samp{public}.")
  513. (separator
  514. (string "")
  515. "Hierarchy separator to use. You should use the same separator for
  516. all namespaces or some clients get confused. @samp{/} is usually a good
  517. one. The default however depends on the underlying mail storage
  518. format.")
  519. (prefix
  520. (string "")
  521. "Prefix required to access this namespace. This needs to be
  522. different for all namespaces. For example @samp{Public/}.")
  523. (location
  524. (string "")
  525. "Physical location of the mailbox. This is in same format as
  526. mail_location, which is also the default for it.")
  527. (inbox?
  528. (boolean #f)
  529. "There can be only one INBOX, and this setting defines which
  530. namespace has it.")
  531. (hidden?
  532. (boolean #f)
  533. "If namespace is hidden, it's not advertised to clients via NAMESPACE
  534. extension. You'll most likely also want to set @samp{list? #f}. This is mostly
  535. useful when converting from another server with different namespaces
  536. which you want to deprecate but still keep working. For example you can
  537. create hidden namespaces with prefixes @samp{~/mail/}, @samp{~%u/mail/}
  538. and @samp{mail/}.")
  539. (list?
  540. (boolean #t)
  541. "Show the mailboxes under this namespace with LIST command. This
  542. makes the namespace visible for clients that don't support NAMESPACE
  543. extension. The special @code{children} value lists child mailboxes, but
  544. hides the namespace prefix.")
  545. (subscriptions?
  546. (boolean #t)
  547. "Namespace handles its own subscriptions. If set to @code{#f}, the
  548. parent namespace handles them. The empty prefix should always have this
  549. as @code{#t}.)")
  550. (mailboxes
  551. (mailbox-configuration-list '())
  552. "List of predefined mailboxes in this namespace."))
  553. (define (serialize-namespace-configuration field-name val)
  554. (format #t "namespace ~a {\n" (namespace-configuration-name val))
  555. (serialize-configuration val (cdr namespace-configuration-fields))
  556. (format #t "}\n"))
  557. (define (list-of-namespace-configuration? val)
  558. (and (list? val) (and-map namespace-configuration? val)))
  559. (define (serialize-list-of-namespace-configuration field-name val)
  560. (for-each (lambda (val)
  561. (serialize-namespace-configuration field-name val))
  562. val))
  563. (define-configuration dovecot-configuration
  564. (dovecot
  565. (file-like dovecot)
  566. "The dovecot package.")
  567. (listen
  568. (comma-separated-string-list '("*" "::"))
  569. "A list of IPs or hosts where to listen in for connections. @samp{*}
  570. listens in all IPv4 interfaces, @samp{::} listens in all IPv6
  571. interfaces. If you want to specify non-default ports or anything more
  572. complex, customize the address and port fields of the
  573. @samp{inet-listener} of the specific services you are interested in.")
  574. (dict
  575. (dict-configuration (dict-configuration))
  576. "Dict configuration, as created by the @code{dict-configuration}
  577. constructor.")
  578. (passdbs
  579. (passdb-configuration-list (list (passdb-configuration (driver "pam"))))
  580. "List of passdb configurations, each one created by the
  581. @code{passdb-configuration} constructor.")
  582. (userdbs
  583. (userdb-configuration-list (list (userdb-configuration (driver "passwd"))))
  584. "List of userdb configurations, each one created by the
  585. @code{userdb-configuration} constructor.")
  586. (plugin-configuration
  587. (plugin-configuration (plugin-configuration))
  588. "Plug-in configuration, created by the @code{plugin-configuration}
  589. constructor.")
  590. (namespaces
  591. (list-of-namespace-configuration
  592. (list
  593. (namespace-configuration
  594. (name "inbox")
  595. (prefix "")
  596. (inbox? #t)
  597. (mailboxes
  598. (list
  599. (mailbox-configuration (name "Drafts") (special-use '("\\Drafts")))
  600. (mailbox-configuration (name "Junk") (special-use '("\\Junk")))
  601. (mailbox-configuration (name "Trash") (special-use '("\\Trash")))
  602. (mailbox-configuration (name "Sent") (special-use '("\\Sent")))
  603. (mailbox-configuration (name "Sent Messages") (special-use '("\\Sent")))
  604. (mailbox-configuration (name "Drafts") (special-use '("\\Drafts"))))))))
  605. "List of namespaces. Each item in the list is created by the
  606. @code{namespace-configuration} constructor.")
  607. (base-dir
  608. (file-name "/var/run/dovecot/")
  609. "Base directory where to store runtime data.")
  610. (login-greeting
  611. (string "Dovecot ready.")
  612. "Greeting message for clients.")
  613. (login-trusted-networks
  614. (space-separated-string-list '())
  615. "List of trusted network ranges. Connections from these IPs are
  616. allowed to override their IP addresses and ports (for logging and for
  617. authentication checks). @samp{disable-plaintext-auth} is also ignored
  618. for these networks. Typically you'd specify your IMAP proxy servers
  619. here.")
  620. (login-access-sockets
  621. (space-separated-string-list '())
  622. "List of login access check sockets (e.g. tcpwrap).")
  623. (verbose-proctitle?
  624. (boolean #f)
  625. "Show more verbose process titles (in ps). Currently shows user name
  626. and IP address. Useful for seeing who are actually using the IMAP
  627. processes (e.g. shared mailboxes or if same uid is used for multiple
  628. accounts).")
  629. (shutdown-clients?
  630. (boolean #t)
  631. "Should all processes be killed when Dovecot master process shuts down.
  632. Setting this to @code{#f} means that Dovecot can be upgraded without
  633. forcing existing client connections to close (although that could also
  634. be a problem if the upgrade is e.g. because of a security fix).")
  635. (doveadm-worker-count
  636. (non-negative-integer 0)
  637. "If non-zero, run mail commands via this many connections to doveadm
  638. server, instead of running them directly in the same process.")
  639. (doveadm-socket-path
  640. (string "doveadm-server")
  641. "UNIX socket or host:port used for connecting to doveadm server.")
  642. (import-environment
  643. (space-separated-string-list '("TZ"))
  644. "List of environment variables that are preserved on Dovecot startup
  645. and passed down to all of its child processes. You can also give
  646. key=value pairs to always set specific settings.")
  647. ;;; Authentication processes
  648. (disable-plaintext-auth?
  649. (boolean #t)
  650. "Disable LOGIN command and all other plaintext authentications unless
  651. SSL/TLS is used (LOGINDISABLED capability). Note that if the remote IP
  652. matches the local IP (i.e. you're connecting from the same computer),
  653. the connection is considered secure and plaintext authentication is
  654. allowed. See also ssl=required setting.")
  655. (auth-cache-size
  656. (non-negative-integer 0)
  657. "Authentication cache size (e.g. @samp{#e10e6}). 0 means it's disabled.
  658. Note that bsdauth, PAM and vpopmail require @samp{cache-key} to be set
  659. for caching to be used.")
  660. (auth-cache-ttl
  661. (string "1 hour")
  662. "Time to live for cached data. After TTL expires the cached record
  663. is no longer used, *except* if the main database lookup returns internal
  664. failure. We also try to handle password changes automatically: If
  665. user's previous authentication was successful, but this one wasn't, the
  666. cache isn't used. For now this works only with plaintext
  667. authentication.")
  668. (auth-cache-negative-ttl
  669. (string "1 hour")
  670. "TTL for negative hits (user not found, password mismatch).
  671. 0 disables caching them completely.")
  672. (auth-realms
  673. (space-separated-string-list '())
  674. "List of realms for SASL authentication mechanisms that need them.
  675. You can leave it empty if you don't want to support multiple realms.
  676. Many clients simply use the first one listed here, so keep the default
  677. realm first.")
  678. (auth-default-realm
  679. (string "")
  680. "Default realm/domain to use if none was specified. This is used for
  681. both SASL realms and appending @@domain to username in plaintext
  682. logins.")
  683. (auth-username-chars
  684. (string
  685. "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890.-_@")
  686. "List of allowed characters in username. If the user-given username
  687. contains a character not listed in here, the login automatically fails.
  688. This is just an extra check to make sure user can't exploit any
  689. potential quote escaping vulnerabilities with SQL/LDAP databases. If
  690. you want to allow all characters, set this value to empty.")
  691. (auth-username-translation
  692. (string "")
  693. "Username character translations before it's looked up from
  694. databases. The value contains series of from -> to characters. For
  695. example @samp{#@@/@@} means that @samp{#} and @samp{/} characters are
  696. translated to @samp{@@}.")
  697. (auth-username-format
  698. (string "%Lu")
  699. "Username formatting before it's looked up from databases. You can
  700. use the standard variables here, e.g. %Lu would lowercase the username,
  701. %n would drop away the domain if it was given, or @samp{%n-AT-%d} would
  702. change the @samp{@@} into @samp{-AT-}. This translation is done after
  703. @samp{auth-username-translation} changes.")
  704. (auth-master-user-separator
  705. (string "")
  706. "If you want to allow master users to log in by specifying the master
  707. username within the normal username string (i.e. not using SASL
  708. mechanism's support for it), you can specify the separator character
  709. here. The format is then <username><separator><master username>.
  710. UW-IMAP uses @samp{*} as the separator, so that could be a good
  711. choice.")
  712. (auth-anonymous-username
  713. (string "anonymous")
  714. "Username to use for users logging in with ANONYMOUS SASL
  715. mechanism.")
  716. (auth-worker-max-count
  717. (non-negative-integer 30)
  718. "Maximum number of dovecot-auth worker processes. They're used to
  719. execute blocking passdb and userdb queries (e.g. MySQL and PAM).
  720. They're automatically created and destroyed as needed.")
  721. (auth-gssapi-hostname
  722. (string "")
  723. "Host name to use in GSSAPI principal names. The default is to use
  724. the name returned by gethostname(). Use @samp{$ALL} (with quotes) to
  725. allow all keytab entries.")
  726. (auth-krb5-keytab
  727. (string "")
  728. "Kerberos keytab to use for the GSSAPI mechanism. Will use the
  729. system default (usually /etc/krb5.keytab) if not specified. You may
  730. need to change the auth service to run as root to be able to read this
  731. file.")
  732. (auth-use-winbind?
  733. (boolean #f)
  734. "Do NTLM and GSS-SPNEGO authentication using Samba's winbind daemon
  735. and @samp{ntlm-auth} helper.
  736. <doc/wiki/Authentication/Mechanisms/Winbind.txt>.")
  737. (auth-winbind-helper-path
  738. (file-name "/usr/bin/ntlm_auth")
  739. "Path for Samba's @samp{ntlm-auth} helper binary.")
  740. (auth-failure-delay
  741. (string "2 secs")
  742. "Time to delay before replying to failed authentications.")
  743. (auth-ssl-require-client-cert?
  744. (boolean #f)
  745. "Require a valid SSL client certificate or the authentication
  746. fails.")
  747. (auth-ssl-username-from-cert?
  748. (boolean #f)
  749. "Take the username from client's SSL certificate, using
  750. @code{X509_NAME_get_text_by_NID()} which returns the subject's DN's
  751. CommonName.")
  752. (auth-mechanisms
  753. (space-separated-string-list '("plain"))
  754. "List of wanted authentication mechanisms. Supported mechanisms are:
  755. @samp{plain}, @samp{login}, @samp{digest-md5}, @samp{cram-md5},
  756. @samp{ntlm}, @samp{rpa}, @samp{apop}, @samp{anonymous}, @samp{gssapi},
  757. @samp{otp}, @samp{skey}, and @samp{gss-spnego}. NOTE: See also
  758. @samp{disable-plaintext-auth} setting.")
  759. (director-servers
  760. (space-separated-string-list '())
  761. "List of IPs or hostnames to all director servers, including ourself.
  762. Ports can be specified as ip:port. The default port is the same as what
  763. director service's @samp{inet-listener} is using.")
  764. (director-mail-servers
  765. (space-separated-string-list '())
  766. "List of IPs or hostnames to all backend mail servers. Ranges are
  767. allowed too, like 10.0.0.10-10.0.0.30.")
  768. (director-user-expire
  769. (string "15 min")
  770. "How long to redirect users to a specific server after it no longer
  771. has any connections.")
  772. (director-username-hash
  773. (string "%Lu")
  774. "How the username is translated before being hashed. Useful values
  775. include %Ln if user can log in with or without @@domain, %Ld if mailboxes
  776. are shared within domain.")
  777. ;;; Log destination.
  778. (log-path
  779. (string "syslog")
  780. "Log file to use for error messages. @samp{syslog} logs to syslog,
  781. @samp{/dev/stderr} logs to stderr.")
  782. (info-log-path
  783. (string "")
  784. "Log file to use for informational messages. Defaults to
  785. @samp{log-path}.")
  786. (debug-log-path
  787. (string "")
  788. "Log file to use for debug messages. Defaults to
  789. @samp{info-log-path}.")
  790. (syslog-facility
  791. (string "mail")
  792. "Syslog facility to use if you're logging to syslog. Usually if you
  793. don't want to use @samp{mail}, you'll use local0..local7. Also other
  794. standard facilities are supported.")
  795. (auth-verbose?
  796. (boolean #f)
  797. "Log unsuccessful authentication attempts and the reasons why they
  798. failed.")
  799. (auth-verbose-passwords
  800. (string "no")
  801. "In case of password mismatches, log the attempted password. Valid
  802. values are no, plain and sha1. sha1 can be useful for detecting brute
  803. force password attempts vs. user simply trying the same password over
  804. and over again. You can also truncate the value to n chars by appending
  805. \":n\" (e.g. sha1:6).")
  806. (auth-debug?
  807. (boolean #f)
  808. "Even more verbose logging for debugging purposes. Shows for example
  809. SQL queries.")
  810. (auth-debug-passwords?
  811. (boolean #f)
  812. "In case of password mismatches, log the passwords and used scheme so
  813. the problem can be debugged. Enabling this also enables
  814. @samp{auth-debug}.")
  815. (mail-debug?
  816. (boolean #f)
  817. "Enable mail process debugging. This can help you figure out why
  818. Dovecot isn't finding your mails.")
  819. (verbose-ssl?
  820. (boolean #f)
  821. "Show protocol level SSL errors.")
  822. (log-timestamp
  823. (string "\"%b %d %H:%M:%S \"")
  824. "Prefix for each line written to log file. % codes are in
  825. strftime(3) format.")
  826. (login-log-format-elements
  827. (space-separated-string-list
  828. '("user=<%u>" "method=%m" "rip=%r" "lip=%l" "mpid=%e" "%c"))
  829. "List of elements we want to log. The elements which have a
  830. non-empty variable value are joined together to form a comma-separated
  831. string.")
  832. (login-log-format
  833. (string "%$: %s")
  834. "Login log format. %s contains @samp{login-log-format-elements}
  835. string, %$ contains the data we want to log.")
  836. (mail-log-prefix
  837. (string "\"%s(%u)<%{pid}><%{session}>: \"")
  838. "Log prefix for mail processes. See doc/wiki/Variables.txt for list
  839. of possible variables you can use.")
  840. (deliver-log-format
  841. (string "msgid=%m: %$")
  842. "Format to use for logging mail deliveries. You can use variables:
  843. @table @code
  844. @item %$
  845. Delivery status message (e.g. @samp{saved to INBOX})
  846. @item %m
  847. Message-ID
  848. @item %s
  849. Subject
  850. @item %f
  851. From address
  852. @item %p
  853. Physical size
  854. @item %w
  855. Virtual size.
  856. @end table")
  857. ;;; Mailbox locations and namespaces
  858. (mail-location
  859. (string "")
  860. "Location for users' mailboxes. The default is empty, which means
  861. that Dovecot tries to find the mailboxes automatically. This won't work
  862. if the user doesn't yet have any mail, so you should explicitly tell
  863. Dovecot the full location.
  864. If you're using mbox, giving a path to the INBOX
  865. file (e.g. /var/mail/%u) isn't enough. You'll also need to tell Dovecot
  866. where the other mailboxes are kept. This is called the \"root mail
  867. directory\", and it must be the first path given in the
  868. @samp{mail-location} setting.
  869. There are a few special variables you can use, eg.:
  870. @table @samp
  871. @item %u
  872. username
  873. @item %n
  874. user part in user@@domain, same as %u if there's no domain
  875. @item %d
  876. domain part in user@@domain, empty if there's no domain
  877. @item %h
  878. home director
  879. @end table
  880. See doc/wiki/Variables.txt for full list. Some examples:
  881. @table @samp
  882. @item maildir:~/Maildir
  883. @item mbox:~/mail:INBOX=/var/mail/%u
  884. @item mbox:/var/mail/%d/%1n/%n:INDEX=/var/indexes/%d/%1n/%
  885. @end table")
  886. (mail-uid
  887. (string "")
  888. "System user and group used to access mails. If you use multiple,
  889. userdb can override these by returning uid or gid fields. You can use
  890. either numbers or names. <doc/wiki/UserIds.txt>.")
  891. (mail-gid
  892. (string "")
  893. "")
  894. (mail-privileged-group
  895. (string "")
  896. "Group to enable temporarily for privileged operations. Currently
  897. this is used only with INBOX when either its initial creation or
  898. dotlocking fails. Typically this is set to \"mail\" to give access to
  899. /var/mail.")
  900. (mail-access-groups
  901. (string "")
  902. "Grant access to these supplementary groups for mail processes.
  903. Typically these are used to set up access to shared mailboxes. Note
  904. that it may be dangerous to set these if users can create
  905. symlinks (e.g. if \"mail\" group is set here, ln -s /var/mail ~/mail/var
  906. could allow a user to delete others' mailboxes, or ln -s
  907. /secret/shared/box ~/mail/mybox would allow reading it).")
  908. (mail-full-filesystem-access?
  909. (boolean #f)
  910. "Allow full file system access to clients. There's no access checks
  911. other than what the operating system does for the active UID/GID. It
  912. works with both maildir and mboxes, allowing you to prefix mailboxes
  913. names with e.g. /path/ or ~user/.")
  914. ;;; Mail processes
  915. (mmap-disable?
  916. (boolean #f)
  917. "Don't use mmap() at all. This is required if you store indexes to
  918. shared file systems (NFS or clustered file system).")
  919. (dotlock-use-excl?
  920. (boolean #t)
  921. "Rely on @samp{O_EXCL} to work when creating dotlock files. NFS
  922. supports @samp{O_EXCL} since version 3, so this should be safe to use
  923. nowadays by default.")
  924. (mail-fsync
  925. (string "optimized")
  926. "When to use fsync() or fdatasync() calls:
  927. @table @code
  928. @item optimized
  929. Whenever necessary to avoid losing important data
  930. @item always
  931. Useful with e.g. NFS when write()s are delayed
  932. @item never
  933. Never use it (best performance, but crashes can lose data).
  934. @end table")
  935. (mail-nfs-storage?
  936. (boolean #f)
  937. "Mail storage exists in NFS. Set this to yes to make Dovecot flush
  938. NFS caches whenever needed. If you're using only a single mail server
  939. this isn't needed.")
  940. (mail-nfs-index?
  941. (boolean #f)
  942. "Mail index files also exist in NFS. Setting this to yes requires
  943. @samp{mmap-disable? #t} and @samp{fsync-disable? #f}.")
  944. (lock-method
  945. (string "fcntl")
  946. "Locking method for index files. Alternatives are fcntl, flock and
  947. dotlock. Dotlocking uses some tricks which may create more disk I/O
  948. than other locking methods. NFS users: flock doesn't work, remember to
  949. change @samp{mmap-disable}.")
  950. (mail-temp-dir
  951. (file-name "/tmp")
  952. "Directory in which LDA/LMTP temporarily stores incoming mails >128
  953. kB.")
  954. (first-valid-uid
  955. (non-negative-integer 500)
  956. "Valid UID range for users. This is mostly to make sure that users can't
  957. log in as daemons or other system users. Note that denying root logins is
  958. hardcoded to dovecot binary and can't be done even if @samp{first-valid-uid}
  959. is set to 0.")
  960. (last-valid-uid
  961. (non-negative-integer 0)
  962. "")
  963. (first-valid-gid
  964. (non-negative-integer 1)
  965. "Valid GID range for users. Users having non-valid GID as primary group ID
  966. aren't allowed to log in. If user belongs to supplementary groups with
  967. non-valid GIDs, those groups are not set.")
  968. (last-valid-gid
  969. (non-negative-integer 0)
  970. "")
  971. (mail-max-keyword-length
  972. (non-negative-integer 50)
  973. "Maximum allowed length for mail keyword name. It's only forced when
  974. trying to create new keywords.")
  975. (valid-chroot-dirs
  976. (colon-separated-file-name-list '())
  977. "List of directories under which chrooting is allowed for mail
  978. processes (i.e. /var/mail will allow chrooting to /var/mail/foo/bar
  979. too). This setting doesn't affect @samp{login-chroot}
  980. @samp{mail-chroot} or auth chroot settings. If this setting is empty,
  981. \"/./\" in home dirs are ignored. WARNING: Never add directories here
  982. which local users can modify, that may lead to root exploit. Usually
  983. this should be done only if you don't allow shell access for users.
  984. <doc/wiki/Chrooting.txt>.")
  985. (mail-chroot
  986. (string "")
  987. "Default chroot directory for mail processes. This can be overridden
  988. for specific users in user database by giving /./ in user's home
  989. directory (e.g. /home/./user chroots into /home). Note that usually
  990. there is no real need to do chrooting, Dovecot doesn't allow users to
  991. access files outside their mail directory anyway. If your home
  992. directories are prefixed with the chroot directory, append \"/.\" to
  993. @samp{mail-chroot}. <doc/wiki/Chrooting.txt>.")
  994. (auth-socket-path
  995. (file-name "/var/run/dovecot/auth-userdb")
  996. "UNIX socket path to master authentication server to find users.
  997. This is used by imap (for shared users) and lda.")
  998. (mail-plugin-dir
  999. (file-name "/usr/lib/dovecot")
  1000. "Directory where to look up mail plugins.")
  1001. (mail-plugins
  1002. (space-separated-string-list '())
  1003. "List of plugins to load for all services. Plugins specific to IMAP,
  1004. LDA, etc. are added to this list in their own .conf files.")
  1005. (mail-cache-min-mail-count
  1006. (non-negative-integer 0)
  1007. "The minimum number of mails in a mailbox before updates are done to
  1008. cache file. This allows optimizing Dovecot's behavior to do less disk
  1009. writes at the cost of more disk reads.")
  1010. (mailbox-idle-check-interval
  1011. (string "30 secs")
  1012. "When IDLE command is running, mailbox is checked once in a while to
  1013. see if there are any new mails or other changes. This setting defines
  1014. the minimum time to wait between those checks. Dovecot can also use
  1015. dnotify, inotify and kqueue to find out immediately when changes
  1016. occur.")
  1017. (mail-save-crlf?
  1018. (boolean #f)
  1019. "Save mails with CR+LF instead of plain LF. This makes sending those
  1020. mails take less CPU, especially with sendfile() syscall with Linux and
  1021. FreeBSD. But it also creates a bit more disk I/O which may just make it
  1022. slower. Also note that if other software reads the mboxes/maildirs,
  1023. they may handle the extra CRs wrong and cause problems.")
  1024. (maildir-stat-dirs?
  1025. (boolean #f)
  1026. "By default LIST command returns all entries in maildir beginning
  1027. with a dot. Enabling this option makes Dovecot return only entries
  1028. which are directories. This is done by stat()ing each entry, so it
  1029. causes more disk I/O.
  1030. (For systems setting struct @samp{dirent->d_type} this check is free
  1031. and it's done always regardless of this setting).")
  1032. (maildir-copy-with-hardlinks?
  1033. (boolean #t)
  1034. "When copying a message, do it with hard links whenever possible.
  1035. This makes the performance much better, and it's unlikely to have any
  1036. side effects.")
  1037. (maildir-very-dirty-syncs?
  1038. (boolean #f)
  1039. "Assume Dovecot is the only MUA accessing Maildir: Scan cur/
  1040. directory only when its mtime changes unexpectedly or when we can't find
  1041. the mail otherwise.")
  1042. (mbox-read-locks
  1043. (space-separated-string-list '("fcntl"))
  1044. "Which locking methods to use for locking mbox. There are four
  1045. available:
  1046. @table @code
  1047. @item dotlock
  1048. Create <mailbox>.lock file. This is the oldest and most NFS-safe
  1049. solution. If you want to use /var/mail/ like directory, the users will
  1050. need write access to that directory.
  1051. @item dotlock-try
  1052. Same as dotlock, but if it fails because of permissions or because there
  1053. isn't enough disk space, just skip it.
  1054. @item fcntl
  1055. Use this if possible. Works with NFS too if lockd is used.
  1056. @item flock
  1057. May not exist in all systems. Doesn't work with NFS.
  1058. @item lockf
  1059. May not exist in all systems. Doesn't work with NFS.
  1060. @end table
  1061. You can use multiple locking methods; if you do the order they're declared
  1062. in is important to avoid deadlocks if other MTAs/MUAs are using multiple
  1063. locking methods as well. Some operating systems don't allow using some of
  1064. them simultaneously.")
  1065. (mbox-write-locks
  1066. (space-separated-string-list '("dotlock" "fcntl"))
  1067. "")
  1068. (mbox-lock-timeout
  1069. (string "5 mins")
  1070. "Maximum time to wait for lock (all of them) before aborting.")
  1071. (mbox-dotlock-change-timeout
  1072. (string "2 mins")
  1073. "If dotlock exists but the mailbox isn't modified in any way,
  1074. override the lock file after this much time.")
  1075. (mbox-dirty-syncs?
  1076. (boolean #t)
  1077. "When mbox changes unexpectedly we have to fully read it to find out
  1078. what changed. If the mbox is large this can take a long time. Since
  1079. the change is usually just a newly appended mail, it'd be faster to
  1080. simply read the new mails. If this setting is enabled, Dovecot does
  1081. this but still safely fallbacks to re-reading the whole mbox file
  1082. whenever something in mbox isn't how it's expected to be. The only real
  1083. downside to this setting is that if some other MUA changes message
  1084. flags, Dovecot doesn't notice it immediately. Note that a full sync is
  1085. done with SELECT, EXAMINE, EXPUNGE and CHECK commands.")
  1086. (mbox-very-dirty-syncs?
  1087. (boolean #f)
  1088. "Like @samp{mbox-dirty-syncs}, but don't do full syncs even with SELECT,
  1089. EXAMINE, EXPUNGE or CHECK commands. If this is set,
  1090. @samp{mbox-dirty-syncs} is ignored.")
  1091. (mbox-lazy-writes?
  1092. (boolean #t)
  1093. "Delay writing mbox headers until doing a full write sync (EXPUNGE
  1094. and CHECK commands and when closing the mailbox). This is especially
  1095. useful for POP3 where clients often delete all mails. The downside is
  1096. that our changes aren't immediately visible to other MUAs.")
  1097. (mbox-min-index-size
  1098. (non-negative-integer 0)
  1099. "If mbox size is smaller than this (e.g. 100k), don't write index
  1100. files. If an index file already exists it's still read, just not
  1101. updated.")
  1102. (mdbox-rotate-size
  1103. (non-negative-integer #e10e6)
  1104. "Maximum dbox file size until it's rotated.")
  1105. (mdbox-rotate-interval
  1106. (string "1d")
  1107. "Maximum dbox file age until it's rotated. Typically in days. Day
  1108. begins from midnight, so 1d = today, 2d = yesterday, etc. 0 = check
  1109. disabled.")
  1110. (mdbox-preallocate-space?
  1111. (boolean #f)
  1112. "When creating new mdbox files, immediately preallocate their size to
  1113. @samp{mdbox-rotate-size}. This setting currently works only in Linux
  1114. with some file systems (ext4, xfs).")
  1115. (mail-attribute-dict
  1116. (string "")
  1117. "The location of a dictionary used to store @code{IMAP METADATA}
  1118. as defined by @uref{https://tools.ietf.org/html/rfc5464, RFC@tie{}5464}.
  1119. The IMAP METADATA commands are available only if the ``imap''
  1120. protocol configuration's @code{imap-metadata?} field is @samp{#t}.")
  1121. (mail-attachment-dir
  1122. (string "")
  1123. "sdbox and mdbox support saving mail attachments to external files,
  1124. which also allows single instance storage for them. Other backends
  1125. don't support this for now.
  1126. WARNING: This feature hasn't been tested much yet. Use at your own risk.
  1127. Directory root where to store mail attachments. Disabled, if empty.")
  1128. (mail-attachment-min-size
  1129. (non-negative-integer #e128e3)
  1130. "Attachments smaller than this aren't saved externally. It's also
  1131. possible to write a plugin to disable saving specific attachments
  1132. externally.")
  1133. (mail-attachment-fs
  1134. (string "sis posix")
  1135. "File system backend to use for saving attachments:
  1136. @table @code
  1137. @item posix
  1138. No SiS done by Dovecot (but this might help FS's own deduplication)
  1139. @item sis posix
  1140. SiS with immediate byte-by-byte comparison during saving
  1141. @item sis-queue posix
  1142. SiS with delayed comparison and deduplication.
  1143. @end table")
  1144. (mail-attachment-hash
  1145. (string "%{sha1}")
  1146. "Hash format to use in attachment filenames. You can add any text and
  1147. variables: @code{%@{md4@}}, @code{%@{md5@}}, @code{%@{sha1@}},
  1148. @code{%@{sha256@}}, @code{%@{sha512@}}, @code{%@{size@}}. Variables can be
  1149. truncated, e.g. @code{%@{sha256:80@}} returns only first 80 bits.")
  1150. (default-process-limit
  1151. (non-negative-integer 100)
  1152. "")
  1153. (default-client-limit
  1154. (non-negative-integer 1000)
  1155. "")
  1156. (default-vsz-limit
  1157. (non-negative-integer #e256e6)
  1158. "Default VSZ (virtual memory size) limit for service processes.
  1159. This is mainly intended to catch and kill processes that leak memory
  1160. before they eat up everything.")
  1161. (default-login-user
  1162. (string "dovenull")
  1163. "Login user is internally used by login processes. This is the most
  1164. untrusted user in Dovecot system. It shouldn't have access to anything
  1165. at all.")
  1166. (default-internal-user
  1167. (string "dovecot")
  1168. "Internal user is used by unprivileged processes. It should be
  1169. separate from login user, so that login processes can't disturb other
  1170. processes.")
  1171. (ssl?
  1172. (string "required")
  1173. "SSL/TLS support: yes, no, required. <doc/wiki/SSL.txt>.")
  1174. (ssl-cert
  1175. (string "</etc/dovecot/default.pem")
  1176. "PEM encoded X.509 SSL/TLS certificate (public key).")
  1177. (ssl-key
  1178. (string "</etc/dovecot/private/default.pem")
  1179. "PEM encoded SSL/TLS private key. The key is opened before
  1180. dropping root privileges, so keep the key file unreadable by anyone but
  1181. root.")
  1182. (ssl-key-password
  1183. (string "")
  1184. "If key file is password protected, give the password here.
  1185. Alternatively give it when starting dovecot with -p parameter. Since
  1186. this file is often world-readable, you may want to place this setting
  1187. instead to a different.")
  1188. (ssl-ca
  1189. (string "")
  1190. "PEM encoded trusted certificate authority. Set this only if you
  1191. intend to use @samp{ssl-verify-client-cert? #t}. The file should
  1192. contain the CA certificate(s) followed by the matching
  1193. CRL(s). (e.g. @samp{ssl-ca </etc/ssl/certs/ca.pem}).")
  1194. (ssl-require-crl?
  1195. (boolean #t)
  1196. "Require that CRL check succeeds for client certificates.")
  1197. (ssl-verify-client-cert?
  1198. (boolean #f)
  1199. "Request client to send a certificate. If you also want to require
  1200. it, set @samp{auth-ssl-require-client-cert? #t} in auth section.")
  1201. (ssl-cert-username-field
  1202. (string "commonName")
  1203. "Which field from certificate to use for username. commonName and
  1204. x500UniqueIdentifier are the usual choices. You'll also need to set
  1205. @samp{auth-ssl-username-from-cert? #t}.")
  1206. (ssl-min-protocol
  1207. (string "TLSv1")
  1208. "Minimum SSL protocol version to accept.")
  1209. (ssl-cipher-list
  1210. (string "ALL:!kRSA:!SRP:!kDHd:!DSS:!aNULL:!eNULL:!EXPORT:!DES:!3DES:!MD5:!PSK:!RC4:!ADH:!LOW@STRENGTH")
  1211. "SSL ciphers to use.")
  1212. (ssl-crypto-device
  1213. (string "")
  1214. "SSL crypto device to use, for valid values run \"openssl engine\".")
  1215. (postmaster-address
  1216. (string "postmaster@%d")
  1217. "Address to use when sending rejection mails.
  1218. Default is postmaster@@<your domain>. %d expands to recipient domain.")
  1219. (hostname
  1220. (string "")
  1221. "Hostname to use in various parts of sent mails (e.g. in Message-Id)
  1222. and in LMTP replies. Default is the system's real hostname@@domain.")
  1223. (quota-full-tempfail?
  1224. (boolean #f)
  1225. "If user is over quota, return with temporary failure instead of
  1226. bouncing the mail.")
  1227. (sendmail-path
  1228. (file-name "/usr/sbin/sendmail")
  1229. "Binary to use for sending mails.")
  1230. (submission-host
  1231. (string "")
  1232. "If non-empty, send mails via this SMTP host[:port] instead of
  1233. sendmail.")
  1234. (rejection-subject
  1235. (string "Rejected: %s")
  1236. "Subject: header to use for rejection mails. You can use the same
  1237. variables as for @samp{rejection-reason} below.")
  1238. (rejection-reason
  1239. (string "Your message to <%t> was automatically rejected:%n%r")
  1240. "Human readable error message for rejection mails. You can use
  1241. variables:
  1242. @table @code
  1243. @item %n
  1244. CRLF
  1245. @item %r
  1246. reason
  1247. @item %s
  1248. original subject
  1249. @item %t
  1250. recipient
  1251. @end table")
  1252. (recipient-delimiter
  1253. (string "+")
  1254. "Delimiter character between local-part and detail in email
  1255. address.")
  1256. (lda-original-recipient-header
  1257. (string "")
  1258. "Header where the original recipient address (SMTP's RCPT TO:
  1259. address) is taken from if not available elsewhere. With dovecot-lda -a
  1260. parameter overrides this. A commonly used header for this is
  1261. X-Original-To.")
  1262. (lda-mailbox-autocreate?
  1263. (boolean #f)
  1264. "Should saving a mail to a nonexistent mailbox automatically create
  1265. it?.")
  1266. (lda-mailbox-autosubscribe?
  1267. (boolean #f)
  1268. "Should automatically created mailboxes be also automatically
  1269. subscribed?.")
  1270. (imap-max-line-length
  1271. (non-negative-integer #e64e3)
  1272. "Maximum IMAP command line length. Some clients generate very long
  1273. command lines with huge mailboxes, so you may need to raise this if you
  1274. get \"Too long argument\" or \"IMAP command line too large\" errors
  1275. often.")
  1276. (imap-logout-format
  1277. (string "in=%i out=%o deleted=%{deleted} expunged=%{expunged} trashed=%{trashed} hdr_count=%{fetch_hdr_count} hdr_bytes=%{fetch_hdr_bytes} body_count=%{fetch_body_count} body_bytes=%{fetch_body_bytes}")
  1278. "IMAP logout format string:
  1279. @table @code
  1280. @item %i
  1281. total number of bytes read from client
  1282. @item %o
  1283. total number of bytes sent to client.
  1284. @end table
  1285. See @file{doc/wiki/Variables.txt} for a list of all the variables you can use.")
  1286. (imap-capability
  1287. (string "")
  1288. "Override the IMAP CAPABILITY response. If the value begins with '+',
  1289. add the given capabilities on top of the defaults (e.g. +XFOO XBAR).")
  1290. (imap-idle-notify-interval
  1291. (string "2 mins")
  1292. "How long to wait between \"OK Still here\" notifications when client
  1293. is IDLEing.")
  1294. (imap-id-send
  1295. (string "")
  1296. "ID field names and values to send to clients. Using * as the value
  1297. makes Dovecot use the default value. The following fields have default
  1298. values currently: name, version, os, os-version, support-url,
  1299. support-email.")
  1300. (imap-id-log
  1301. (string "")
  1302. "ID fields sent by client to log. * means everything.")
  1303. (imap-client-workarounds
  1304. (space-separated-string-list '())
  1305. "Workarounds for various client bugs:
  1306. @table @code
  1307. @item delay-newmail
  1308. Send EXISTS/RECENT new mail notifications only when replying to NOOP and
  1309. CHECK commands. Some clients ignore them otherwise, for example OSX
  1310. Mail (<v2.1). Outlook Express breaks more badly though, without this it
  1311. may show user \"Message no longer in server\" errors. Note that OE6
  1312. still breaks even with this workaround if synchronization is set to
  1313. \"Headers Only\".
  1314. @item tb-extra-mailbox-sep
  1315. Thunderbird gets somehow confused with LAYOUT=fs (mbox and dbox) and
  1316. adds extra @samp{/} suffixes to mailbox names. This option causes Dovecot to
  1317. ignore the extra @samp{/} instead of treating it as invalid mailbox name.
  1318. @item tb-lsub-flags
  1319. Show \\Noselect flags for LSUB replies with LAYOUT=fs (e.g. mbox).
  1320. This makes Thunderbird realize they aren't selectable and show them
  1321. greyed out, instead of only later giving \"not selectable\" popup error.
  1322. @end table
  1323. ")
  1324. (imap-urlauth-host
  1325. (string "")
  1326. "Host allowed in URLAUTH URLs sent by client. \"*\" allows all.")
  1327. (protocols
  1328. (protocol-configuration-list
  1329. (list (protocol-configuration
  1330. (name "imap"))))
  1331. "List of protocols we want to serve. Available protocols include
  1332. @samp{imap}, @samp{pop3}, and @samp{lmtp}.")
  1333. (services
  1334. (service-configuration-list
  1335. (list
  1336. (service-configuration
  1337. (kind "imap-login")
  1338. (client-limit 0)
  1339. (process-limit 0)
  1340. (listeners
  1341. (list
  1342. (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f))
  1343. (inet-listener-configuration (protocol "imaps") (port 993) (ssl? #t)))))
  1344. (service-configuration
  1345. (kind "pop3-login")
  1346. (listeners
  1347. (list
  1348. (inet-listener-configuration (protocol "pop3") (port 110) (ssl? #f))
  1349. (inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t)))))
  1350. (service-configuration
  1351. (kind "lmtp")
  1352. (client-limit 1)
  1353. (process-limit 0)
  1354. (listeners
  1355. (list (unix-listener-configuration (path "lmtp") (mode "0666")))))
  1356. (service-configuration
  1357. (kind "imap")
  1358. (client-limit 1)
  1359. (process-limit 1024))
  1360. (service-configuration
  1361. (kind "pop3")
  1362. (client-limit 1)
  1363. (process-limit 1024))
  1364. (service-configuration
  1365. (kind "auth")
  1366. (service-count 0)
  1367. (client-limit 0)
  1368. (process-limit 1)
  1369. (listeners
  1370. (list (unix-listener-configuration (path "auth-userdb")))))
  1371. (service-configuration
  1372. (kind "auth-worker")
  1373. (client-limit 1)
  1374. (process-limit 0))
  1375. (service-configuration
  1376. (kind "dict")
  1377. (client-limit 1)
  1378. (process-limit 0)
  1379. (listeners (list (unix-listener-configuration (path "dict")))))))
  1380. "List of services to enable. Available services include @samp{imap},
  1381. @samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and
  1382. @samp{lmtp}."))
  1383. (define-configuration opaque-dovecot-configuration
  1384. (dovecot
  1385. (file-like dovecot)
  1386. "The dovecot package.")
  1387. (string
  1388. (string (configuration-missing-field 'opaque-dovecot-configuration
  1389. 'string))
  1390. "The contents of the @code{dovecot.conf} to use."))
  1391. (define %dovecot-accounts
  1392. ;; Account and group for the Dovecot daemon.
  1393. (list (user-group (name "dovecot") (system? #t))
  1394. (user-account
  1395. (name "dovecot")
  1396. (group "dovecot")
  1397. (system? #t)
  1398. (comment "Dovecot daemon user")
  1399. (home-directory "/var/empty")
  1400. (shell (file-append shadow "/sbin/nologin")))
  1401. (user-group (name "dovenull") (system? #t))
  1402. (user-account
  1403. (name "dovenull")
  1404. (group "dovenull")
  1405. (system? #t)
  1406. (comment "Dovecot daemon login user")
  1407. (home-directory "/var/empty")
  1408. (shell (file-append shadow "/sbin/nologin")))))
  1409. (define (%dovecot-activation config)
  1410. ;; Activation gexp.
  1411. (let ((config-str
  1412. (cond
  1413. ((opaque-dovecot-configuration? config)
  1414. (opaque-dovecot-configuration-string config))
  1415. (else
  1416. (with-output-to-string
  1417. (lambda ()
  1418. (serialize-configuration config
  1419. dovecot-configuration-fields)))))))
  1420. #~(begin
  1421. (use-modules (guix build utils))
  1422. (define (mkdir-p/perms directory owner perms)
  1423. (mkdir-p directory)
  1424. (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
  1425. (chmod directory perms))
  1426. (define (build-subject parameters)
  1427. (string-concatenate
  1428. (map (lambda (pair)
  1429. (let ((k (car pair)) (v (cdr pair)))
  1430. (define (escape-char str chr)
  1431. (string-join (string-split str chr) (string #\\ chr)))
  1432. (string-append "/" k "="
  1433. (escape-char (escape-char v #\=) #\/))))
  1434. (filter (lambda (pair) (cdr pair)) parameters))))
  1435. (define* (create-self-signed-certificate-if-absent
  1436. #:key private-key public-key (owner (getpwnam "root"))
  1437. (common-name (gethostname))
  1438. (organization-name "Guix")
  1439. (organization-unit-name "Default Self-Signed Certificate")
  1440. (subject-parameters `(("CN" . ,common-name)
  1441. ("O" . ,organization-name)
  1442. ("OU" . ,organization-unit-name)))
  1443. (subject (build-subject subject-parameters)))
  1444. ;; Note that by default, OpenSSL outputs keys in PEM format. This
  1445. ;; is what we want.
  1446. (unless (file-exists? private-key)
  1447. (cond
  1448. ((zero? (system* (string-append #$openssl "/bin/openssl")
  1449. "genrsa" "-out" private-key "2048"))
  1450. (chown private-key (passwd:uid owner) (passwd:gid owner))
  1451. (chmod private-key #o400))
  1452. (else
  1453. (format (current-error-port)
  1454. "Failed to create private key at ~a.\n" private-key))))
  1455. (unless (file-exists? public-key)
  1456. (cond
  1457. ((zero? (system* (string-append #$openssl "/bin/openssl")
  1458. "req" "-new" "-x509" "-key" private-key
  1459. "-out" public-key "-days" "3650"
  1460. "-batch" "-subj" subject))
  1461. (chown public-key (passwd:uid owner) (passwd:gid owner))
  1462. (chmod public-key #o444))
  1463. (else
  1464. (format (current-error-port)
  1465. "Failed to create public key at ~a.\n" public-key)))))
  1466. (let ((user (getpwnam "dovecot")))
  1467. (mkdir-p/perms "/var/run/dovecot" user #o755)
  1468. (mkdir-p/perms "/var/lib/dovecot" user #o755)
  1469. (mkdir-p/perms "/etc/dovecot" user #o755)
  1470. (copy-file #$(plain-file "dovecot.conf" config-str)
  1471. "/etc/dovecot/dovecot.conf")
  1472. (mkdir-p/perms "/etc/dovecot/private" user #o700)
  1473. (create-self-signed-certificate-if-absent
  1474. #:private-key "/etc/dovecot/private/default.pem"
  1475. #:public-key "/etc/dovecot/default.pem"
  1476. #:owner (getpwnam "root")
  1477. #:common-name (format #f "Dovecot service on ~a" (gethostname)))))))
  1478. (define (dovecot-shepherd-service config)
  1479. "Return a list of <shepherd-service> for CONFIG."
  1480. (let ((dovecot (if (opaque-dovecot-configuration? config)
  1481. (opaque-dovecot-configuration-dovecot config)
  1482. (dovecot-configuration-dovecot config))))
  1483. (list (shepherd-service
  1484. (documentation "Run the Dovecot POP3/IMAP mail server.")
  1485. (provision '(dovecot))
  1486. (requirement '(networking))
  1487. (start #~(make-forkexec-constructor
  1488. (list (string-append #$dovecot "/sbin/dovecot")
  1489. "-F")))
  1490. (stop #~(lambda _
  1491. (invoke #$(file-append dovecot "/sbin/dovecot")
  1492. "stop")
  1493. #f))))))
  1494. (define %dovecot-pam-services
  1495. (list (unix-pam-service "dovecot")))
  1496. (define dovecot-service-type
  1497. (service-type (name 'dovecot)
  1498. (extensions
  1499. (list (service-extension shepherd-root-service-type
  1500. dovecot-shepherd-service)
  1501. (service-extension account-service-type
  1502. (const %dovecot-accounts))
  1503. (service-extension pam-root-service-type
  1504. (const %dovecot-pam-services))
  1505. (service-extension activation-service-type
  1506. %dovecot-activation)))
  1507. (description "Run Dovecot, a mail server that can run POP3,
  1508. IMAP, and LMTP.")))
  1509. (define* (dovecot-service #:key (config (dovecot-configuration)))
  1510. "Return a service that runs @command{dovecot}, a mail server that can run
  1511. POP3, IMAP, and LMTP. @var{config} should be a configuration object created
  1512. by @code{dovecot-configuration}. @var{config} may also be created by
  1513. @code{opaque-dovecot-configuration}, which allows specification of the
  1514. @code{dovecot.conf} as a string."
  1515. (service dovecot-service-type config))
  1516. ;; A little helper to make it easier to document all those fields.
  1517. (define (generate-dovecot-documentation)
  1518. (generate-documentation
  1519. `((dovecot-configuration
  1520. ,dovecot-configuration-fields
  1521. (dict dict-configuration)
  1522. (namespaces namespace-configuration)
  1523. (plugin plugin-configuration)
  1524. (passdbs passdb-configuration)
  1525. (userdbs userdb-configuration)
  1526. (services service-configuration)
  1527. (protocols protocol-configuration))
  1528. (dict-configuration ,dict-configuration-fields)
  1529. (plugin-configuration ,plugin-configuration-fields)
  1530. (passdb-configuration ,passdb-configuration-fields)
  1531. (userdb-configuration ,userdb-configuration-fields)
  1532. (unix-listener-configuration ,unix-listener-configuration-fields)
  1533. (fifo-listener-configuration ,fifo-listener-configuration-fields)
  1534. (inet-listener-configuration ,inet-listener-configuration-fields)
  1535. (namespace-configuration
  1536. ,namespace-configuration-fields
  1537. (mailboxes mailbox-configuration))
  1538. (mailbox-configuration ,mailbox-configuration-fields)
  1539. (service-configuration
  1540. ,service-configuration-fields
  1541. (listeners unix-listener-configuration fifo-listener-configuration
  1542. inet-listener-configuration))
  1543. (protocol-configuration ,protocol-configuration-fields))
  1544. 'dovecot-configuration))
  1545. ;;;
  1546. ;;; OpenSMTPD.
  1547. ;;;
  1548. ;;; This next bit of code helps me create my own sanitizer functions.
  1549. ;; some fieldnames have a default value of #f, which is ok. They cannot have a value of #t.
  1550. ;; for example opensmtpd-table-data can be #f, BUT NOT true.
  1551. ;; my/sanitize procedure tests values to see if they are of the right kind.
  1552. ;; procedure false? is needed to allow fields like 'values' to be blank, (empty), or #f BUT also
  1553. ;; have a value like a list of strings.
  1554. (define (false? var)
  1555. (eq? #f var))
  1556. ;; this procedure takes in a var and a list of procedures. It loops through list of procedures passing in var to each.
  1557. ;; if one procedure returns #t, the function returns true. Otherwise #f.
  1558. ;; TODO for fun rewrite this using map
  1559. ;; If I rewrote it in map, then it may help with sanitizing.
  1560. ;; eg: I could then potentially easily sanitize vars with lambda procedures.
  1561. (define (is-value-right-type? var list-of-procedures record fieldname)
  1562. (if (null? list-of-procedures)
  1563. #f
  1564. (if ((car list-of-procedures) var)
  1565. #t
  1566. (is-value-right-type? var (cdr list-of-procedures) record fieldname))))
  1567. ;; converts strings like this:
  1568. ;; "apple, ham, cherry" -> "apple, ham, or cherry"
  1569. ;; "pineapple" -> "pinneapple".
  1570. ;; "cheese, grapefruit, or jam" -> "cheese, grapefruit, or jam"
  1571. (define (add-comma-or string)
  1572. (define last-comma-location (string-rindex string #\,))
  1573. (if last-comma-location
  1574. (if (string-contains string ", or" last-comma-location)
  1575. string
  1576. (string-replace string ", or" last-comma-location
  1577. (+ 1 last-comma-location)))
  1578. string))
  1579. (define (list-of-procedures->string procedures)
  1580. (define string
  1581. (let loop ((procedures procedures))
  1582. (if (null? procedures)
  1583. ""
  1584. (begin
  1585. (string-append
  1586. (cond ((eq? false? (car procedures))
  1587. "#f, ")
  1588. ((eq? boolean? (car procedures))
  1589. "boolean, ")
  1590. ((eq? string? (car procedures))
  1591. "string, ")
  1592. ((eq? integer? (car procedures))
  1593. "integer, ")
  1594. ((eq? list-of-strings? (car procedures))
  1595. "list of strings, ")
  1596. ((eq? assoc-list? (car procedures))
  1597. "an association list of strings, ")
  1598. ((eq? opensmtpd-pki? (car procedures))
  1599. "an <opensmtpd-pki> record, ")
  1600. ((eq? opensmtpd-table? (car procedures))
  1601. "an <opensmtpd-table> record, ")
  1602. ((eq? list-of-unique-opensmtpd-match? (car procedures))
  1603. "a list of unique <opensmtpd-match> records, ")
  1604. ((eq? list-of-strings-or-gexps? (car procedures))
  1605. "a list of strings or gexps, ")
  1606. ((eq? table-whose-data-are-assoc-list? (car procedures))
  1607. (string-append
  1608. "an <opensmtpd-table> record whose fieldname 'data' are an assoc-list \n"
  1609. "for example: (opensmtpd-table (name \"hostnames\") (data '((\"124.394.23.1\" . \"gnu.org\")))), "))
  1610. ((eq? table-whose-data-are-a-list-of-strings? (car procedures))
  1611. (string-append
  1612. "on <opensmtpd-table> record whose fieldname 'data' is a list of strings \n"
  1613. "for example: (opensmtpd-table (name \"domains\") (data (list \"gnu.org\" \"guix.gnu.org\"))), "))
  1614. ((eq? file-exists? (car procedures))
  1615. "file, ")
  1616. (else "has an incorrect value, "))
  1617. (loop (cdr procedures)))))))
  1618. (add-comma-or (string-append (string-drop-right string 2) ".\n")))
  1619. (define (list-of-strings-or-gexps? list)
  1620. (and (list? list)
  1621. (cond ((null? list)
  1622. #t)
  1623. ((or (string? (car list))
  1624. (gexp? (car list))
  1625. (local-file? (car list))
  1626. (file-append? (car list))
  1627. (plain-file? (car list))
  1628. (computed-file? (car list))
  1629. (program-file? (car list)))
  1630. (list-of-strings-or-gexps? (cdr list)))
  1631. (else #f))))
  1632. (define (my/sanitize var record fieldname list-of-procedures)
  1633. (if (is-value-right-type? var list-of-procedures record fieldname)
  1634. var
  1635. (begin
  1636. (display (string-append "<" record "> fieldname: '" fieldname "' is of type "
  1637. (list-of-procedures->string list-of-procedures) "\n"))
  1638. (throw 'bad! var))))
  1639. ;;; The Opensmtpd Records.
  1640. ;; Some example opensmtpd-tables:
  1641. ;;
  1642. ;; (opensmtpd-table (name "root accounts")
  1643. ;; (data '(("joshua" . "root@dismail.de")
  1644. ;; ("joshua" . "postmaster@dismail.de"))))
  1645. ;; (opensmtpd-table (name "root accounts")
  1646. ;; (data (list "mysite.me" "your-site.com")))
  1647. ;; TODO: how am I supporting file: or db: tables?
  1648. ;; Perhaps I should just automatically convert the table to a database table
  1649. ;; if the data gets large enough. What would be sufficently large enough?
  1650. (define-record-type* <opensmtpd-table>
  1651. opensmtpd-table make-opensmtpd-table
  1652. opensmtpd-table?
  1653. (name opensmtpd-table-name ;; string
  1654. (default #f)
  1655. (sanitize (lambda (var)
  1656. (my/sanitize var "opensmtpd-table" "name" (list string?)))))
  1657. ;; FIXME support an aliasing table as described here:
  1658. ;; https://man.openbsd.org/table.5
  1659. ;; One may have to use the record file for this. I don't think tables support a table like this:
  1660. ;; table "name" { joshua = joshua@gnucode.me,joshua@gnu-hurd.com,joshua@propernaming.org, root = root@gnucode.me }
  1661. ;; If values is an absolute filename, then it will use said filename to house the table info.
  1662. ;; filename must be an absolute filename.
  1663. (data opensmtpd-table-data
  1664. (default #f)
  1665. (sanitize (lambda (var)
  1666. (my/sanitize var "opensmtpd-table" "data"
  1667. (list list-of-strings? assoc-list?))))))
  1668. (define-record-type* <opensmtpd-ca>
  1669. opensmtpd-ca make-opensmtpd-ca
  1670. opensmtpd-ca?
  1671. (name opensmtpd-ca-name
  1672. (default #f)
  1673. (sanitize (lambda (var)
  1674. (my/sanitize var "opensmtpd-ca" "name" (list string?)))))
  1675. (file opensmtpd-ca-file
  1676. (default #f)
  1677. (sanitize (lambda (var)
  1678. (my/sanitize var "opensmtpd-ca" "file" (list file-exists?))))))
  1679. (define-record-type* <opensmtpd-pki>
  1680. opensmtpd-pki make-opensmtpd-pki
  1681. opensmtpd-pki?
  1682. (domain opensmtpd-pki-domain
  1683. (default #f)
  1684. (sanitize (lambda (var)
  1685. (my/sanitize var "opensmtpd-pki" "domain" (list string?)))))
  1686. ;; TODO/FIXME this should probably be a list of files. The opensmtpd documentation says
  1687. ;; that you could have a list of files:
  1688. ;;
  1689. ;; pki pkiname cert certfile
  1690. ;; Associate certificate file certfile with host pkiname, and use that file to prove
  1691. ;; the identity of the mail server to clients. pkiname is the server's name, de‐
  1692. ;; rived from the default hostname or set using either
  1693. ;; /gnu/store/2d13sdz76ldq8zgwv4wif0zx7hkr3mh2-opensmtpd-6.8.0p2/etc/mailname or us‐
  1694. ;; ing the hostname directive. If a fallback certificate or SNI is wanted, the ‘*’
  1695. ;; wildcard may be used as pkiname.
  1696. ;; A certificate chain may be created by appending one or many certificates, includ‐
  1697. ;; ing a Certificate Authority certificate, to certfile. The creation of certifi‐
  1698. ;; cates is documented in starttls(8).
  1699. (cert opensmtpd-pki-cert
  1700. (default #f)
  1701. (sanitize (lambda (var)
  1702. (my/sanitize var "opensmtpd-pki" "cert" (list file-exists?)))))
  1703. (key opensmtpd-pki-key
  1704. (default #f)
  1705. (sanitize (lambda (var)
  1706. (my/sanitize var "opensmtpd-pki" "key" (list file-exists?)))))
  1707. ; todo sanitize this. valid parameters are "none", "legacy", or "auto".
  1708. (dhe opensmtpd-pki-dhe
  1709. (default #f)
  1710. (sanitize (lambda (var)
  1711. (my/sanitize var "opensmtpd-dhe" "dhe" (list false? string?))))))
  1712. (define-record-type* <opensmtpd-lmtp>
  1713. opensmtpd-lmtp make-opensmtpd-lmtp
  1714. opensmtpd-lmtp?
  1715. (destination opensmtpd-lmtp-destination
  1716. (default #f)
  1717. (sanitize (lambda (var)
  1718. (my/sanitize var "opensmtpd-lmtp" "destination"
  1719. (list string?)))))
  1720. (rcpt-to opensmtpd-lmtp-rcpt-to
  1721. (default #f)
  1722. (sanitize (lambda (var)
  1723. (my/sanitize var "opensmtpd-lmtp" "rcpt-to"
  1724. (list false? string?))))))
  1725. (define-record-type* <opensmtpd-mda>
  1726. opensmtpd-mda make-opensmtpd-mda
  1727. opensmtpd-mda?
  1728. (name opensmtpd-mda-name
  1729. (default #f)
  1730. (sanitize (lambda (var)
  1731. (my/sanitize var "opensmtpd-mda" "name"
  1732. (list string?)))))
  1733. ;; TODO should I allow this command to be a gexp?
  1734. (command opensmtpd-mda-command
  1735. (default #f)
  1736. (sanitize (lambda (var)
  1737. (my/sanitize var "opensmtpd-mda" "command"
  1738. (list string?))))))
  1739. (define-record-type* <opensmtpd-maildir>
  1740. opensmtpd-maildir make-opensmtpd-maildir
  1741. opensmtpd-maildir?
  1742. (pathname opensmtpd-maildir-pathname
  1743. (default #f)
  1744. (sanitize (lambda (var)
  1745. (my/sanitize var "opensmtpd-maildir" "pathname"
  1746. (list false? string?)))))
  1747. (junk opensmtpd-maildir-junk
  1748. (default #f)
  1749. (sanitize (lambda (var)
  1750. (my/sanitize var "opensmtpd-maildir" "junk"
  1751. (list boolean?))))))
  1752. (define-record-type* <opensmtpd-local-delivery>
  1753. opensmtpd-local-delivery make-opensmtpd-local-delivery
  1754. opensmtpd-local-delivery?
  1755. (name opensmtpd-local-delivery-name
  1756. (default #f)
  1757. (sanitize (lambda (var)
  1758. (my/sanitize var "opensmtpd-local-delivery" "name"
  1759. (list string?)))))
  1760. (method opensmtpd-local-delivery-method
  1761. (default "mbox")
  1762. (sanitize (lambda (var)
  1763. (cond
  1764. ((or (opensmtpd-lmtp? var)
  1765. (opensmtpd-maildir? var)
  1766. (opensmtpd-mda? var)
  1767. (member var (list "mbox"
  1768. "expand-only"
  1769. "forward-only")))
  1770. var)
  1771. (else
  1772. (begin
  1773. (display (string-append "<opensmtpd-local-delivery> fieldname 'method' must be of type \n"
  1774. "\"mbox\", \"expand-only\", \"forward-only\" \n"
  1775. "<opensmtpd-lmtp>, <opensmtpd-maildir>, \n"
  1776. "or <opensmtpd-mda>.\n"))
  1777. (throw 'bad! var)))))))
  1778. (alias opensmtpd-local-delivery-alias
  1779. (default #f)
  1780. (sanitize (lambda (var)
  1781. (my/sanitize var "opensmtpd-local-delivery" "alias"
  1782. (list false? table-whose-data-are-assoc-list?)))))
  1783. (ttl opensmtpd-local-delivery-ttl
  1784. (default #f)
  1785. (sanitize (lambda (var)
  1786. (my/sanitize var "opensmtpd-local-delivery" "ttl"
  1787. (list false? string?)))))
  1788. (user opensmtpd-local-delivery-user
  1789. (default #f)
  1790. (sanitize (lambda (var)
  1791. (my/sanitize var "opensmtpd-local-delivery" "user"
  1792. (list false? string?)))))
  1793. (userbase opensmtpd-local-delivery-userbase
  1794. (default #f)
  1795. (sanitize (lambda (var)
  1796. (my/sanitize var "opensmtpd-local-delivery" "userbase"
  1797. (list false? opensmtpd-table?)))))
  1798. (virtual opensmtpd-local-delivery-virtual
  1799. (default #f)
  1800. (sanitize (lambda (var)
  1801. (my/sanitize var "opensmtpd-local-delivery" "virtual"
  1802. (list false? table-whose-data-are-assoc-list?)))))
  1803. (wrapper opensmtpd-local-delivery-wrapper
  1804. (default #f)
  1805. (sanitize (lambda (var)
  1806. (my/sanitize var "opensmtpd-local-delivery" "wrapper"
  1807. (list false? string?))))))
  1808. (define-record-type* <opensmtpd-relay>
  1809. opensmtpd-relay make-opensmtpd-relay
  1810. opensmtpd-relay?
  1811. (name opensmtpd-relay-name
  1812. (sanitize (lambda (var)
  1813. (my/sanitize var "opensmtpd-relay" "name"
  1814. (list string?))))
  1815. (default #f))
  1816. (backup opensmtpd-relay-backup ;; boolean
  1817. (default #f)
  1818. (sanitize (lambda (var)
  1819. (my/sanitize var "opensmtpd-relay" "backup"
  1820. (list boolean?)))))
  1821. (backup-mx opensmtpd-relay-backup-mx ;; string mx name
  1822. (default #f)
  1823. (sanitize (lambda (var)
  1824. (my/sanitize var "opensmtpd-relay" "backup-mx"
  1825. (list false? string?)))))
  1826. (helo opensmtpd-relay-helo
  1827. (sanitize (lambda (var)
  1828. (my/sanitize var "opensmtpd-relay" "helo"
  1829. (list false? string? opensmtpd-table?))))
  1830. (default #f))
  1831. (helo-src opensmtpd-relay-helo-src
  1832. (sanitize (lambda (var)
  1833. (my/sanitize var "opensmtpd-relay" "helo-src"
  1834. (list false? string? opensmtpd-table?))))
  1835. (default #f))
  1836. (domain opensmtpd-relay-domain
  1837. (sanitize (lambda (var)
  1838. (my/sanitize var "opensmtpd-relay" "domain"
  1839. (list false? opensmtpd-table?))))
  1840. (default #f))
  1841. (host opensmtpd-relay-host
  1842. (sanitize (lambda (var)
  1843. (my/sanitize var "opensmtpd-relay" "host"
  1844. (list false? string?))))
  1845. (default #f))
  1846. (pki opensmtpd-relay-pki
  1847. (default #f)
  1848. (sanitize (lambda (var)
  1849. (my/sanitize var "opensmtpd-relay" "pki"
  1850. (list false? opensmtpd-pki?)))))
  1851. (srs opensmtpd-relay-srs
  1852. (default #f)
  1853. (lambda (var)
  1854. (my/sanitize var "opensmtpd-relay" "srs"
  1855. (list boolean?))))
  1856. (tls opensmtpd-relay-tls
  1857. (default #f)
  1858. (sanitize (lambda (var)
  1859. (my/sanitize var "opensmtpd-relay" "tls"
  1860. (list false? string?)))))
  1861. (auth opensmtpd-relay-auth
  1862. (sanitize (lambda (var)
  1863. (my/sanitize var "opensmtpd-relay" "auth"
  1864. (list false? opensmtpd-table?))))
  1865. (default #f))
  1866. (mail-from opensmtpd-relay-mail-from
  1867. (default #f))
  1868. ;; string "127.0.0.1" or "<interface>" or "<table of IP addresses>"
  1869. ;; TODO should I do some sanitizing to make sure that the string? here is actually an IP address or a valid interface?
  1870. (src opensmtpd-relay-src
  1871. (sanitize (lambda (var)
  1872. (my/sanitize var "opensmtpd-relay" "src"
  1873. (list false? string? opensmtpd-table?))))
  1874. (default #f)))
  1875. ;; this record is used by <opensmtpd-filter-phase> &
  1876. ;; <opensmtpd-match>
  1877. (define-record-type* <opensmtpd-option>
  1878. opensmtpd-option make-opensmtpd-option
  1879. opensmtpd-option?
  1880. (option opensmtpd-option-option
  1881. (default #f)
  1882. (sanitize (lambda (var)
  1883. (if (and (string? var)
  1884. (or (member var (list "fcrdns" "rdns"
  1885. "src" "helo" "auth"
  1886. "mail-from" "rcpt-to" "for"
  1887. "for any" "for local"
  1888. "for domain" "for rcpt-to"
  1889. "from any" "from auth"
  1890. "from local" "from mail-from"
  1891. "from rdns" "from socket"
  1892. "from src" "auth" "helo"
  1893. "mail-from" "rcpt-to" "tag"
  1894. "tls"))))
  1895. var
  1896. (begin
  1897. (display (string-append "<opensmtpd-option> fieldname: 'option' is of type \n"
  1898. "string. The string can be either 'fcrdns', \n"
  1899. " 'rdns', 'src', 'helo', 'auth', 'mail-from', or 'rcpt-to', \n"
  1900. "'for', 'for any', 'for local', 'for domain', 'for rcpt-to', \n"
  1901. "'from any', 'from auth', 'from local', 'from mail-from', 'from rdns', 'from socket', \n"
  1902. "'from src', 'auth helo', 'mail-from', 'rcpt-to', 'tag', or 'tls' \n"))
  1903. (throw 'bad! var))))))
  1904. (not opensmtpd-option-not
  1905. (default #f)
  1906. (sanitize (lambda (var)
  1907. (my/sanitize var "opensmtpd-option" "not"
  1908. (list boolean?)))))
  1909. (regex opensmtpd-option-regex
  1910. (default #f)
  1911. (sanitize (lambda (var)
  1912. (my/sanitize var "opensmtpd-option" "regex"
  1913. (list boolean?)))))
  1914. (data opensmtpd-option-data
  1915. (default #f)
  1916. (sanitize (lambda (var)
  1917. (my/sanitize var "opensmtpd-option" "data"
  1918. (list false? string? opensmtpd-table?))))))
  1919. (define-record-type* <opensmtpd-filter-phase>
  1920. opensmtpd-filter-phase make-opensmtpd-filter-phase
  1921. opensmtpd-filter-phase?
  1922. (name opensmtpd-filter-phase-name ;; string
  1923. (default #f)
  1924. (sanitize (lambda (var)
  1925. (my/sanitize var "opensmtpd-filter-phase" "name"
  1926. (list string?)))))
  1927. (phase opensmtpd-filter-phase-phase ;; string
  1928. (default #f)
  1929. (sanitize (lambda (var)
  1930. (if (and (string? var)
  1931. (member var (list "connect" "helo"
  1932. "mail-from" "rcpt-to"
  1933. "data" "commit")))
  1934. var
  1935. (begin
  1936. (display (string-append "<opensmtpd-filter-phase> fieldname: 'phase' is of type \n"
  1937. "string. The string can be either 'connect',"
  1938. " 'helo', 'mail-from', 'rcpt-to', 'data', or 'commit.'\n "))
  1939. (throw 'bad! var))))))
  1940. (options opensmtpd-filter-phase-options
  1941. (default #f)
  1942. (sanitize (lambda (var)
  1943. (sanitize-options-for-filter-phase-configuration var))))
  1944. (decision opensmtpd-filter-phase-decision
  1945. (default #f)
  1946. (sanitize (lambda (var)
  1947. (if (and (string? var)
  1948. (member var (list "bypass" "disconnect"
  1949. "reject" "rewrite" "junk")))
  1950. var
  1951. (begin
  1952. (display (string-append "<opensmtpd-filter-decision> fieldname: 'decision' is of type \n"
  1953. "string. The string can be either 'bypass',"
  1954. " 'disconnect', 'reject', 'rewrite', or 'junk'.\n"))
  1955. (throw 'bad! var))))))
  1956. (message opensmtpd-filter-phase-message
  1957. (default #f)
  1958. (sanitize (lambda (var)
  1959. (my/sanitize var "opensmtpd-filter-phase" "message"
  1960. (list false? string?)))))
  1961. (value opensmtpd-filter-phase-value
  1962. (default #f)
  1963. (sanitize (lambda (var)
  1964. (my/sanitize var "opensmtpd-filter-phase" "value"
  1965. (list false? number?))))))
  1966. (define-record-type* <opensmtpd-filter>
  1967. opensmtpd-filter make-opensmtpd-filter
  1968. opensmtpd-filter?
  1969. (name opensmtpd-filter-name
  1970. (default #f)
  1971. (sanitize (lambda (var)
  1972. (my/sanitize var "opensmtpd-filter" "name"
  1973. (list string?)))))
  1974. (exec opensmtpd-filter-exec
  1975. (default #f)
  1976. (sanitize (lambda (var)
  1977. (my/sanitize var "opensmtpd-filter" "exec"
  1978. (list boolean?)))))
  1979. (proc opensmtpd-filter-proc ; a string like "rspamd" or the command to start it like "/path/to/rspamd --option=arg --2nd-option=arg2"
  1980. (default #f)
  1981. (sanitize (lambda (var)
  1982. (my/sanitize var "opensmtpd-filter" "proc"
  1983. (list string? list-of-strings-or-gexps?))))))
  1984. ;; There is another type of filter that opensmtpd supports, which is a filter chain.
  1985. ;; A filter chain is a list of <opensmtpd-filter-phase>s and/or <opensmtpd-filter>s.
  1986. ;; This lets you apply several filters under one filter name. I could have defined
  1987. ;; a record type for it, but the record would only have had two fields: name and list-of-filters.
  1988. ;; Why write that as a record? That's too simple.
  1989. ;;
  1990. ;; returns #t if list is a unique list of <opensmtpd-filter> or <opensmtpd-filter-phase>
  1991. ;; returns # otherwise
  1992. (define (opensmtpd-filter-chain? %filters)
  1993. (and (list-of-unique-filter-or-filter-phase? %filters)
  1994. (< 1 (length %filters))))
  1995. (define-record-type* <opensmtpd-interface>
  1996. opensmtpd-interface make-opensmtpd-interface
  1997. opensmtpd-interface?
  1998. ;; interface may be an IP address, interface group, or domain name
  1999. (interface opensmtpd-interface-interface
  2000. (default "lo"))
  2001. (family opensmtpd-interface-family
  2002. (default #f)
  2003. (sanitize (lambda (var)
  2004. (cond
  2005. ((eq? #f var) ;; var == #f
  2006. var)
  2007. ((and (string? var)
  2008. (member var (list "inet4" "inet6")))
  2009. var)
  2010. (else
  2011. (begin
  2012. (display "<opensmtpd-interface> fieldname 'family' must be string \"inet4\" or \"inet6\".\n")
  2013. (throw 'bad! var)))))))
  2014. (auth opensmtpd-interface-auth
  2015. (default #f)
  2016. (sanitize (lambda (var)
  2017. (my/sanitize var "opensmtpd-interface" "auth"
  2018. (list boolean? table-whose-data-are-assoc-list?)))))
  2019. (auth-optional opensmtpd-interface-auth-optional
  2020. (default #f)
  2021. (sanitize (lambda (var)
  2022. (my/sanitize var "opensmtpd-interface" "auth-optional"
  2023. (list boolean?
  2024. table-whose-data-are-assoc-list?)))))
  2025. ;; TODO add a ca entry?
  2026. ;; string FIXME/TODO sanitize this to support a gexp. That way way the
  2027. ;; includes directive can include my hacky scheme code that I use for opensmtpd-dkimsign.
  2028. (filters opensmtpd-interface-filters
  2029. (default #f)
  2030. (sanitize (lambda (var)
  2031. (sanitize-each-socket-and-interfaces-filters var))))
  2032. (hostname opensmtpd-interface-hostname
  2033. (default #f)
  2034. (sanitize (lambda (var)
  2035. (my/sanitize var "opensmtpd-interface" "hostname"
  2036. (list false? string?)))))
  2037. (hostnames opensmtpd-interface-hostnames
  2038. (default #f)
  2039. (sanitize (lambda (var)
  2040. (my/sanitize var "opensmtpd-interface" "hostnames"
  2041. (list false? table-whose-data-are-assoc-list?)))))
  2042. (mask-src opensmtpd-interface-mask-src
  2043. (default #f)
  2044. (sanitize (lambda (var)
  2045. (my/sanitize var "opensmtpd-interface" "mask-src"
  2046. (list boolean?)))))
  2047. (disable-dsn opensmtpd-interface-disable-dsn
  2048. (default #f))
  2049. (pki opensmtpd-interface-pki
  2050. (default #f)
  2051. (sanitize (lambda (var)
  2052. (my/sanitize var "opensmtpd-interface" "pki"
  2053. (list false? opensmtpd-pki?)))))
  2054. (port opensmtpd-interface-port
  2055. (default #f)
  2056. (sanitize (lambda (var)
  2057. (my/sanitize var "opensmtpd-interface" "port"
  2058. (list false? integer?)))))
  2059. (proxy-v2 opensmtpd-interface-proxy-k2
  2060. (default #f))
  2061. (received-auth opensmtpd-interface-received-auth
  2062. (default #f))
  2063. ;; TODO add in a senders option!
  2064. ;; string or <opensmtpd-senders> record
  2065. ;; (senders opensmtpd-interface-senders
  2066. ;; (sanitize (lambda (var)
  2067. ;; (my/sanitize var "opensmtpd-interface" "port" (list false? integer?))))
  2068. ;; (default #f))
  2069. (secure-connection opensmtpd-interface-secure-connection
  2070. (default #f)
  2071. (sanitize (lambda (var)
  2072. (cond ((boolean? var)
  2073. var)
  2074. ((and (string? var)
  2075. (member var
  2076. (list "smtps" "tls" "tls-require"
  2077. "tls-require-verify")))
  2078. var)
  2079. (else
  2080. (begin
  2081. (display (string-append "<opensmtd-listen-on> fieldname 'secure-connection' can be \n"
  2082. "one of the following strings: \n'smtps', 'tls', 'tls-require', \n"
  2083. "or 'tls-require-verify'.\n"))
  2084. (throw 'bad! var)))))))
  2085. (tag opensmtpd-interface-tag
  2086. (sanitize (lambda (var)
  2087. (my/sanitize var "opensmtpd-interface" "tag"
  2088. (list false? string?))))
  2089. (default #f)))
  2090. (define-record-type* <opensmtpd-socket>
  2091. opensmtpd-socket make-opensmtpd-socket
  2092. opensmtpd-socket?
  2093. ;; false or <opensmtpd-filter> or list of <opensmtpd-filter>
  2094. (filters opensmtpd-socket-filters
  2095. (sanitize (lambda (var)
  2096. (sanitize-each-socket-and-interfaces-filters var)))
  2097. (default #f))
  2098. (mask-src opensmtpd-socket-mask-src
  2099. (default #f))
  2100. (tag opensmtpd-socket-tag
  2101. (sanitize (lambda (var)
  2102. (my/sanitize var "opensmtpd-interface" "tag"
  2103. (list false? string?))))
  2104. (default #f)))
  2105. (define-record-type* <opensmtpd-match>
  2106. opensmtpd-match make-opensmtpd-match
  2107. opensmtpd-match?
  2108. ;;TODO? Perhaps I should add in a reject fieldname. If reject
  2109. ;;is #t, then the match record will be a reject match record.
  2110. ;; (opensmtpd-match (reject #t)) vs. (opensmtpd-match (action 'reject))
  2111. ;; To do this, I will also have to 'reject' mutually exclusive. AND an match with 'reject' can have no action defined.
  2112. (action opensmtpd-match-action
  2113. (default #f)
  2114. (sanitize (lambda (var)
  2115. (if (or (opensmtpd-relay? var)
  2116. (opensmtpd-local-delivery? var)
  2117. (eq? (quote reject) var))
  2118. var
  2119. (begin
  2120. (display
  2121. (string-append "<opensmtpd-match> fieldname 'action' is of type <opensmtpd-relay>, \n"
  2122. "<opensmtpd-local-delivery>, or (quote reject).\n"
  2123. "If its var is (quote reject), then the match rejects the incoming message\n"
  2124. "during the SMTP dialogue.\n"))
  2125. (throw 'bad! var))))))
  2126. (options opensmtpd-match-options
  2127. (default #f)
  2128. (sanitize (lambda (var)
  2129. (sanitize-list-of-options-for-match-configuration var)))))
  2130. (define-record-type* <opensmtpd-smtp>
  2131. opensmtpd-smtp make-opensmtpd-smtp
  2132. opensmtpd-smtp?
  2133. (ciphers opensmtpd-smtp-ciphers
  2134. (default #f)
  2135. (sanitize (lambda (var)
  2136. (my/sanitize var "opensmtpd-smtp" "ciphers"
  2137. (list false? string?)))))
  2138. (limit-max-mails opensmtpd-smtp-limit-max-mails
  2139. (default #f)
  2140. (sanitize (lambda (var)
  2141. (my/sanitize var "opensmtpd-smtp" "limit-max-mails"
  2142. (list false? integer?)))))
  2143. (limit-max-rcpt opensmtpd-smtp-limit-max-rcpt
  2144. (default #f)
  2145. (sanitize (lambda (var)
  2146. (my/sanitize var "opensmtpd-smtp" "limit-max-rcpt"
  2147. (list false? integer?)))))
  2148. (max-message-size opensmtpd-smtp-max-message-size
  2149. (default #f)
  2150. (sanitize (lambda (var)
  2151. (my/sanitize var "opensmtpd-smtp" "max-message-size"
  2152. (list false? integer? string?)))))
  2153. ;; FIXME/TODO the sanitize function of sub-addr-delim should accept a string of length one not string?
  2154. (sub-addr-delim opensmtpd-smtp-sub-addr-delim
  2155. (default #f)
  2156. (sanitize (lambda (var)
  2157. (my/sanitize var "opensmtpd-smtp" "sub-addr-delim"
  2158. (list false? integer? string?))))))
  2159. (define-record-type* <opensmtpd-srs>
  2160. opensmtpd-srs make-opensmtpd-srs
  2161. opensmtpd-srs?
  2162. (key opensmtpd-srs-key
  2163. (default #f)
  2164. (sanitize (lambda (var)
  2165. (my/sanitize var "opensmtpd-srs" "key"
  2166. (list false? boolean? file-exists?)))))
  2167. (backup-key opensmtpd-srs-backup-key
  2168. (default #f)
  2169. (sanitize (lambda (var)
  2170. (my/sanitize var "opensmtpd-srs" "backup-key"
  2171. (list false? integer? file-exists?)))))
  2172. (ttl-delay opensmtpd-srs-ttl-delay
  2173. (default #f)
  2174. (sanitize (lambda (var)
  2175. (my/sanitize var "opensmtpd-srs" "ttl-delay"
  2176. (list false? string?))))))
  2177. (define-record-type* <opensmtpd-queue>
  2178. opensmtpd-queue make-opensmtpd-queue
  2179. opensmtpd-queue?
  2180. (compression opensmtpd-queue-compression
  2181. (default #f)
  2182. (sanitize (lambda (var)
  2183. (my/sanitize var "opensmtpd-queue" "compression"
  2184. (list boolean?)))))
  2185. (encryption opensmtpd-queue-encryption
  2186. (default #f)
  2187. (sanitize (lambda (var)
  2188. (my/sanitize var "opensmtpd-queue" "encryption"
  2189. (list boolean? string? file-exists?)))))
  2190. (ttl-delay opensmtpd-queue-ttl-delay
  2191. (default #f)
  2192. (sanitize (lambda (var)
  2193. (my/sanitize var "opensmtpd-queue" "ttl-delay"
  2194. (list false? string?))))))
  2195. (define-record-type* <opensmtpd-configuration>
  2196. opensmtpd-configuration make-opensmtpd-configuration
  2197. opensmtpd-configuration?
  2198. (package opensmtpd-configuration-package
  2199. (default opensmtpd))
  2200. (config-file opensmtpd-configuration-config-file
  2201. (default #f))
  2202. ;; FIXME/TODO should I include a admd authservid entry?
  2203. ;; TODO sanitize this properly
  2204. (bounce opensmtpd-configuration-bounce
  2205. (default #f)
  2206. (sanitize (lambda (var)
  2207. (my/sanitize var "opensmtpd-configuration" "bounce"
  2208. (list false? list?)))))
  2209. (cas opensmtpd-configuration-cas
  2210. (default #f)
  2211. (sanitize (lambda (var)
  2212. (my/sanitize var "opensmtpd-configuration" "cas"
  2213. (list false? list-of-opensmtpd-ca?)))))
  2214. ;; list of many records of type opensmtpd-interface
  2215. (interfaces opensmtpd-configuration-interfaces
  2216. (default (list (opensmtpd-interface)))
  2217. (sanitize (lambda (var)
  2218. (if (and (list-of-interface? var)
  2219. (not (contains-duplicate? var)))
  2220. var
  2221. (begin
  2222. (display "<opensmtpd-configuration> fieldname 'interface' may be #f or a list of records \n")
  2223. (display "of unique <opensmtpd-interface>.\n")
  2224. (throw 'bad! var))))))
  2225. (socket opensmtpd-configuration-socket
  2226. (default #f)
  2227. (sanitize (lambda (var)
  2228. (if (or (opensmtpd-socket? var)
  2229. (false? var))
  2230. var
  2231. (begin
  2232. (display "<opensmtpd-configuration> fieldname 'socket' may be #f ")
  2233. (display "or an <opensmtpd-socket> record.\n")
  2234. (throw 'bad! var))))))
  2235. (includes opensmtpd-configuration-includes ;; list of strings of absolute path names
  2236. (default #f)
  2237. (sanitize (lambda (var)
  2238. (my/sanitize var "opensmtpd-configuration" "includes"
  2239. (list false? list-of-strings? gexp?)))))
  2240. (matches opensmtpd-configuration-matches
  2241. (default (list (opensmtpd-match
  2242. (action (opensmtpd-local-delivery
  2243. (name "local")
  2244. (method "mbox")))
  2245. (options (list
  2246. (opensmtpd-option
  2247. (option "for local")))))
  2248. (opensmtpd-match
  2249. (action (opensmtpd-relay
  2250. (name "outbound")))
  2251. (options (list
  2252. (opensmtpd-option
  2253. (option "from local"))
  2254. (opensmtpd-option
  2255. (option "for any")))))))
  2256. ;; TODO perhaps I should sanitize this function like I sanitized the 'filters'.
  2257. ;; It might be a bit complicated to do this. I might just let smtpd figure out if the user made a
  2258. ;; silly mistake by having two different actions with the same name.
  2259. ;; I definitely should sanitize this function a bit more. For example, you could have two different
  2260. ;; actions, one for local delivery and one for remote, with the same name. I should make sure that
  2261. ;; I have no two different actions with the same name.
  2262. (sanitize (lambda (var)
  2263. var
  2264. (my/sanitize var "opensmtpd-configuration" "matches"
  2265. (list list-of-unique-opensmtpd-match?)))))
  2266. ;; list of many records of type mda-wrapper
  2267. ;; TODO/FIXME support using gexps here
  2268. ;; eg (list "name" gexp)
  2269. (mda-wrappers opensmtpd-configuration-mda-wrappers
  2270. (default #f)
  2271. (sanitize (lambda (var)
  2272. (my/sanitize var
  2273. "opensmtpd-configuration"
  2274. "mda-wrappers"
  2275. (list false? string?)))))
  2276. (mta-max-deferred opensmtpd-configuration-mta-max-deferred
  2277. (default 100)
  2278. (sanitize (lambda (var)
  2279. (my/sanitize var "opensmtpd-configuration" "mta-max-deferred"
  2280. (list number?)))))
  2281. (queue opensmtpd-configuration-queue
  2282. (default #f)
  2283. (sanitize (lambda (var)
  2284. (my/sanitize var "opensmtpd-configuration" "queue"
  2285. (list false? opensmtpd-queue?)))))
  2286. (smtp opensmtpd-configuration-smtp
  2287. (default #f)
  2288. (sanitize (lambda (var)
  2289. (my/sanitize var "opensmtpd-configuration" "smtp"
  2290. (list false? opensmtpd-smtp?)))))
  2291. (srs opensmtpd-configuration-srs
  2292. (default #f)
  2293. (sanitize (lambda (var)
  2294. (my/sanitize var "opensmtpd-configuration" "srs"
  2295. (list false? opensmtpd-srs?)))))
  2296. (setgid-commands? opensmtpd-setgid-commands? (default #t)))
  2297. ;; this help procedure is used 3 or 4 times by sanitize-list-of-options-for-match-configuration
  2298. (define* (throw-error-duplicate-option option error-arg #:key (record-name "match"))
  2299. (throw-error error-arg
  2300. (list
  2301. (string-append "<opensmtpd-" record-name ">'s fieldname 'options' can only have one \n")
  2302. (string-append "'" option "' option, but more are present. \n")
  2303. (string-append "You can only have one option with value '" option "' in the options list.\n"))))
  2304. ;; this procedure sanitizes the fieldname opensmtpd-match-options
  2305. (define* (sanitize-list-of-options-for-match-configuration %options)
  2306. (cond ((not (list-of-opensmtpd-option? %options))
  2307. (throw-error %options '("<opensmtpd-match> fieldname 'options' is a list of unique \n"
  2308. "<opensmtpd-option> records. \n")))
  2309. ((let loop ((%traversing-options %options)
  2310. ;; sanitized-options is an alist that may end of looking like:
  2311. ;; (("for" (opensmtpd-option (option "for any")))
  2312. ;; ("from" (opensmtpd-option (option "from any"))))
  2313. (%sanitized-options '()))
  2314. (if (null? %traversing-options)
  2315. (remove false?
  2316. (list
  2317. (assoc-ref %sanitized-options "for")
  2318. (assoc-ref %sanitized-options "from")
  2319. (assoc-ref %sanitized-options "auth")
  2320. (assoc-ref %sanitized-options "helo")
  2321. (assoc-ref %sanitized-options "mail-from")
  2322. (assoc-ref %sanitized-options "rcpt-to")
  2323. (assoc-ref %sanitized-options "tag")
  2324. (assoc-ref %sanitized-options "tls")))
  2325. (let* ((option-record (car %traversing-options))
  2326. (option-string (opensmtpd-option-option option-record)))
  2327. (cond ((assoc-ref %sanitized-options option-string) ;; error, if we have a duplicate option
  2328. (throw-error-duplicate-option option-string %traversing-options))
  2329. ;; error, if duplicate from or duplicate for option
  2330. ((or (if (and (string=? "for" (substring option-string 0 3))
  2331. (assoc-ref %sanitized-options "for"))
  2332. #t
  2333. #f)
  2334. (if (and (>= (length (string->list option-string)) 4)
  2335. (string=? "from" (substring option-string 0 4))
  2336. (assoc-ref %sanitized-options "from"))
  2337. #t
  2338. #f))
  2339. (throw-error %options
  2340. (list "<opensmtpd-match>'s fieldname 'options' can only have one 'for' and one 'from' option. \n"
  2341. "But '" option-string "' and '"
  2342. (opensmtpd-option-option
  2343. (if (assoc-ref %sanitized-options "for")
  2344. (assoc-ref %sanitized-options "for")
  2345. (assoc-ref %sanitized-options "from")))
  2346. "' are present.\n")))
  2347. ((string=? "auth" option-string)
  2348. (loop (cdr %traversing-options) (alist-cons "auth" option-record %sanitized-options)))
  2349. ((or (string=? "helo" option-string) ; these 3 options must have fieldname data defined.
  2350. (string=? "mail-from" option-string)
  2351. (string=? "rcpt-to" option-string))
  2352. (if (not (opensmtpd-option-data option-record))
  2353. (throw-error option-record
  2354. (list
  2355. (string-append "<opensmtpd-option> with fieldname 'option' with value '"
  2356. option-string "' \n"
  2357. "must have a 'data' of type string or <opensmtpd-table>.\n")))
  2358. (loop (cdr %traversing-options)
  2359. (alist-cons option-string option-record %sanitized-options))))
  2360. ((string=? "tag" option-string) ;; fieldname data must be a string.
  2361. (if (not (string? (opensmtpd-option-data option-record)))
  2362. (throw-error option-record
  2363. (list "<opensmtpd-option> with fieldname 'option' with value 'tag' \n"
  2364. "must have a 'data' of type string.\n"))
  2365. (loop (cdr %traversing-options) (alist-cons "tag" option-record %sanitized-options))))
  2366. ((or (string=? "tls" option-string)
  2367. (string=? "for" (substring option-string 0 3))
  2368. (string=? "from" (substring option-string 0 4)))
  2369. ;; let's test the "for" and "from" options now.
  2370. (cond
  2371. ;; the options in this list cannot have a data or regex field defined.
  2372. ((and (member option-string (list "for local" "for any"
  2373. "from any" "from local"
  2374. "from socket" "tls"))
  2375. (or (opensmtpd-option-data option-record)
  2376. (opensmtpd-option-regex option-record)))
  2377. (throw-error option-record
  2378. (list "When <openmstpd-option-configuration>'s fieldname 'option' value is '" option-string "' \n"
  2379. "then its 'data' and 'regex' field must be #f. \n")))
  2380. ;; the options in this list must have a data field of type string or
  2381. ;; table-whose-data-are-a-list-of-strings?
  2382. ((and (member option-string (list "for domain" "for rcpt-to"
  2383. "from mail-from" "from src"))
  2384. (or (false? (opensmtpd-option-data option-record))
  2385. (table-whose-data-are-assoc-list?
  2386. (opensmtpd-option-data option-record))))
  2387. (throw-error option-record
  2388. (list "When <openmstpd-option-configuration>'s fieldname 'options' value is '" option-string "' \n"
  2389. "or 'for rcpt-to', then its 'data' field must be a string or an \n"
  2390. "<opensmtpd-table> record whose 'data' is a list of strings.\n")))
  2391. (else
  2392. (loop (cdr %traversing-options)
  2393. (alist-cons (cond ((string=? "for" (substring option-string 0 3))
  2394. "for")
  2395. ((string=? "tls" option-string)
  2396. "tls")
  2397. (else "from"))
  2398. option-record
  2399. %sanitized-options)))))
  2400. (else
  2401. (throw-error option-string
  2402. (list (string-append
  2403. "<opensmtpd-match> fieldname 'options' has an invalid <opensmtpd-option> with an wrong \n"
  2404. " opensmtpd-option-name: " option-string "\n")))))))))))
  2405. (define (list-has-duplicates-or-non-filters? list)
  2406. (not (list-of-unique-filter-or-filter-phase? list)))
  2407. (define (filter-phase-has-message-and-value? record)
  2408. (and (opensmtpd-filter-phase-message record)
  2409. (opensmtpd-filter-phase-value record)))
  2410. ;; return #t if phase needs a message. Or if the message did not start with a 4xx or 5xx status code.
  2411. ;; otherwise #f
  2412. (define (filter-phase-decision-lacks-proper-message? record)
  2413. (define decision (opensmtpd-filter-phase-decision record))
  2414. (if (member decision (list "disconnect" "reject"))
  2415. ;; this message needs to be RFC compliant, meaning
  2416. ;; that it need to start with 4xx or 5xx status code
  2417. (cond ((eq? #f (opensmtpd-filter-phase-message record))
  2418. #t)
  2419. ((string? (opensmtpd-filter-phase-message record))
  2420. (let ((number (string->number
  2421. (substring
  2422. (opensmtpd-filter-phase-message record) 0 3))))
  2423. (if (and (number? number)
  2424. (and (< number 600) (> number 399)))
  2425. #f
  2426. #t))))
  2427. #f))
  2428. ;; 'decision' "rewrite" requires 'value' to be a number.
  2429. (define (filter-phase-lacks-proper-value? record)
  2430. (define decision (opensmtpd-filter-phase-decision record))
  2431. (if (string=? "rewrite" decision)
  2432. (if (and (number? (opensmtpd-filter-phase-value record))
  2433. (eq? #f (opensmtpd-filter-phase-message record)))
  2434. #f
  2435. #t)
  2436. #f))
  2437. ;; 'decision' "junk" or "bypass" cannot have a message or a value.
  2438. (define (filter-phase-has-incorrect-junk-or-bypass? record)
  2439. (and
  2440. (member
  2441. (opensmtpd-filter-phase-decision record)
  2442. (list "junk" "bypass"))
  2443. (or
  2444. (opensmtpd-filter-phase-value record)
  2445. (opensmtpd-filter-phase-message record))))
  2446. (define (filter-phase-junks-after-commit? record)
  2447. (and (string=? (opensmtpd-filter-phase-decision record) "junk")
  2448. (string=? (opensmtpd-filter-phase-phase record) "commit")))
  2449. ;; returns #t if list is a unique list of <opensmtpd-filter> or <opensmtpd-filter-phase>
  2450. ;; returns # otherwise
  2451. (define (list-of-unique-filter-or-filter-phase? %filters)
  2452. (and (list? %filters)
  2453. (not (null? %filters))
  2454. ;; this list is made up of only <opensmtpd-filter-phase> or <opensmtpd-filter>
  2455. (primitive-eval
  2456. (cons 'and (map (lambda (filter)
  2457. (or (opensmtpd-filter? filter)
  2458. (opensmtpd-filter-phase? filter)))
  2459. %filters)))
  2460. (not (contains-duplicate?
  2461. (map ; each filter name is unique?
  2462. (lambda (filter)
  2463. (cond ((opensmtpd-filter? filter)
  2464. (opensmtpd-filter-name filter))
  2465. (else
  2466. (opensmtpd-filter-phase-name filter))))
  2467. %filters)))))
  2468. ;; if the list of filters in %filters (list of filters)
  2469. ;; has two filters with the same name, then this will return #t
  2470. ;; otherwise false. This helps me check if say an opensmtpd-interface-filters,
  2471. ;; has two filters with the same name, which is an error.
  2472. (define (duplicate-filter-name? %filters)
  2473. (contains-duplicate?
  2474. (let loop ((%filters %filters))
  2475. (cond ((null? %filters)
  2476. '())
  2477. ((opensmtpd-filter-phase? (car %filters))
  2478. (cons (opensmtpd-filter-phase-name (car %filters))
  2479. (loop (cdr %filters))))
  2480. (else
  2481. (cons (opensmtpd-filter-name (car %filters))
  2482. (loop (cdr %filters))))))))
  2483. ;; the sanitize procedures used for sanitizing each <opensmtpd-interface> and
  2484. ;; <opensmtpd-socket> fieldname 'filters'.
  2485. ;; It primarily sanitizes <filter-phases>. The only sanitization it does
  2486. ;; for <filter>s, is no make sure there are no duplicate filter names.
  2487. (define (sanitize-each-socket-and-interfaces-filters %list)
  2488. ;; the order of the first two tests in this cond is important.
  2489. ;; (false?) has to be 1st and (list-has-duplicates-or-non-filters?) has to be second.
  2490. ;; You may optionally re-order the other alternates in the cond.
  2491. (cond ((false? %list)
  2492. #f)
  2493. ((list-has-duplicates-or-non-filters? %list)
  2494. (throw-error %list
  2495. (list "is a list, in which each unique element \n"
  2496. "is of type <opensmtpd-filter> or <opensmtpd-filter-phase>.\n")
  2497. #:record-name "interface"
  2498. #:fieldname "filters"))
  2499. ((duplicate-filter-name? %list)
  2500. (throw-error %list (list "has a duplicate filter name.\n")
  2501. #:record-name "interface"
  2502. #:fieldname "filters"))
  2503. (else
  2504. (let loop ((%traversing-list %list)
  2505. (%original-list %list))
  2506. (if (null? %traversing-list)
  2507. %original-list
  2508. (cond ((opensmtpd-filter? (car %traversing-list))
  2509. (loop (cdr %traversing-list) %original-list))
  2510. ((filter-phase-has-message-and-value? (car %traversing-list))
  2511. (begin
  2512. (display (string-append "<opensmtpd-filter-phase> cannot have defined fieldnames 'value' \n"
  2513. "and 'message'.\n"))
  2514. (throw 'bad! (car %traversing-list))))
  2515. ((filter-phase-decision-lacks-proper-message? (car %traversing-list))
  2516. (begin
  2517. (display (string-append "<opensmtpd-filter-phase> fieldname: 'decision' options \n"
  2518. "\"disconnect\" and \"reject\" require fieldname 'message' to have an RFC \n"
  2519. "compliant string, which means that the string must begin with a 4xx or 5xx status code.\n"))
  2520. (throw 'bad! (car %traversing-list))))
  2521. ((filter-phase-lacks-proper-value? (car %traversing-list))
  2522. (begin
  2523. (display (string-append "<opensmtpd-filter-phase> fieldname: 'decision' option \n"
  2524. "\"rewrite\" requires fieldname 'value' to have a number.\n"))
  2525. (throw 'bad! (car %traversing-list))))
  2526. ((filter-phase-has-incorrect-junk-or-bypass? (car %traversing-list))
  2527. (begin
  2528. (display (string-append "<opensmtpd-filter-phase> fieldname 'decision' option \n"
  2529. "\"junk\" or 'bypass' cannot have a defined fieldnames 'message' or 'value'.\n"))
  2530. (throw 'bad! (car %traversing-list))))
  2531. ((filter-phase-junks-after-commit? (car %traversing-list))
  2532. (begin
  2533. (display (string-append "<opensmtpd-filter-phase> fieldname 'decision' option \n"
  2534. "\"junk\" cannot junk an email during 'phase' \"commit\".\n"))
  2535. (throw 'bad! (car %traversing-list))))
  2536. (else (loop (cdr %traversing-list) %original-list))))))))
  2537. (define* (sanitize-options-for-filter-phase-configuration %options)
  2538. (cond ((false? %options)
  2539. (throw-error #f
  2540. (list "must have at least one opensmtpd-option record.\n")
  2541. #:record-name "filter-phase"
  2542. #:fieldname "options"))
  2543. ((not (list-of-opensmtpd-option? %options))
  2544. (throw-error %options
  2545. (list "must be a list of <opensmtpd-option>s.\n")
  2546. #:record-name "filter-phase"
  2547. #:fieldname "options"))
  2548. ((let loop ((%traversing-options %options)
  2549. ;; sanitized-options is an alist that may end of looking like:
  2550. ;; (("fcrdns" (opensmtpd-option (option "fcrdns")))
  2551. ;; ("auth" (opensmtpd-option (option "auth"))))
  2552. (%sanitized-options '()))
  2553. (if (null? %traversing-options)
  2554. (remove false?
  2555. (list
  2556. (assoc-ref %sanitized-options "fcrdns")
  2557. (assoc-ref %sanitized-options "rdns")
  2558. (assoc-ref %sanitized-options "src")
  2559. (assoc-ref %sanitized-options "helo")
  2560. (assoc-ref %sanitized-options "auth")
  2561. (assoc-ref %sanitized-options "mail-from")
  2562. (assoc-ref %sanitized-options "rcpt-to")))
  2563. (let* ((option-record (car %traversing-options))
  2564. (option-string (opensmtpd-option-option option-record)))
  2565. (cond ((assoc-ref %sanitized-options option-string)
  2566. ;; if we see two "rdns" (for example), throw a "duplicate
  2567. ;; option" error.
  2568. (throw-error-duplicate-option option-string option-record
  2569. #:record-name "filter-phase"))
  2570. ;; the next 4 options must have fieldname 'data' defined.
  2571. ((member option-string
  2572. (list "src" "helo"
  2573. "mail-from" "rcpt-to"))
  2574. (if (not (opensmtpd-table?
  2575. (opensmtpd-option-data option-record)))
  2576. (throw-error option-record (list "must have fieldname 'data' defined.\n")
  2577. #:record-name "option"
  2578. #:fieldname option-string)
  2579. (loop (cdr %traversing-options)
  2580. (alist-cons option-string option-record %sanitized-options))))
  2581. ;;fcrdns cannot have fieldname data defined
  2582. ((string=? "fcrdns" option-string)
  2583. (if (opensmtpd-option-data option-record)
  2584. (throw-error option-record (list "cannot have fieldname data defined.\n")
  2585. #:record-name "option"
  2586. #:fieldname "fcrdns")
  2587. (loop (cdr %traversing-options)
  2588. (alist-cons "fcrdns" option-record %sanitized-options))))
  2589. ;; rdns and auth cannot be made invalidly; skip testing them.
  2590. ((member option-string
  2591. (list "rdns" "auth"))
  2592. (loop (cdr %traversing-options)
  2593. (alist-cons option-string option-record
  2594. %sanitized-options)))
  2595. (else (throw-error option-record
  2596. (list "has an invalid option name.")
  2597. #:record-name "filter-phase"
  2598. #:fieldname option-string)))))))))
  2599. (define* (throw-error var %strings
  2600. #:key
  2601. (record-name #f)
  2602. (fieldname #f))
  2603. (if (and record-name fieldname)
  2604. (begin
  2605. (display (string-append "<opensmtpd-" record-name "> fieldname '" fieldname "' "
  2606. (apply string-append %strings)))
  2607. (throw 'bad! var))
  2608. (begin
  2609. (display (apply string-append %strings))
  2610. (throw 'bad! var))))
  2611. ;; this is used for sanitizing <opensmtpd-filter-phase> fieldname 'options'
  2612. (define (contains-duplicate? list)
  2613. (if (null? list)
  2614. #f
  2615. (or
  2616. ;; check if (car list) is in (cdr list)
  2617. (primitive-eval (cons 'or
  2618. (map (lambda (var) (equal? var (car list)))
  2619. (cdr list))))
  2620. ;; check if (cdr list) contains duplicate
  2621. (contains-duplicate? (cdr list)))))
  2622. ;;; Various functions to check that lists are of the appropriate type.
  2623. ;; given a list and procedure, this tests that each element of list is of type
  2624. ;; ie: (list-of-type? list string?) tests each list is of type string.
  2625. (define (list-of-type? list proc?)
  2626. (if (and (list? list)
  2627. (not (null? list)))
  2628. (let loop ((list list))
  2629. (if (null? list)
  2630. #t
  2631. (if (proc? (car list))
  2632. (loop (cdr list))
  2633. #f)))
  2634. #f))
  2635. (define (list-of-strings? list)
  2636. (list-of-type? list string?))
  2637. (define (list-of-interface? list)
  2638. (list-of-type? list opensmtpd-interface?))
  2639. (define (list-of-opensmtpd-option? list)
  2640. (list-of-type?
  2641. list opensmtpd-option?))
  2642. (define (list-of-opensmtpd-ca? list)
  2643. (list-of-type? list opensmtpd-ca?))
  2644. (define (list-of-opensmtpd-pki? list)
  2645. (list-of-type? list opensmtpd-pki?))
  2646. (define (list-of-unique-opensmtpd-match? list)
  2647. (and (list-of-type? list opensmtpd-match?)
  2648. (not (contains-duplicate? list))))
  2649. (define* (list-of-strings->string list
  2650. #:key
  2651. (string-delimiter ", ")
  2652. (postpend "")
  2653. (append "")
  2654. (drop-right-number 2))
  2655. (string-drop-right
  2656. (string-append (let loop ((list list))
  2657. (if (null? list)
  2658. ""
  2659. (string-append append (car list) postpend
  2660. string-delimiter
  2661. (loop (cdr list)))))
  2662. append)
  2663. drop-right-number))
  2664. ;; at the moment I cannot define this by using list-of-type?
  2665. ;; the first (not (null? assoc-list)) prevents that.
  2666. (define (assoc-list? assoc-list)
  2667. (list-of-type? assoc-list
  2668. (lambda (pair)
  2669. (if (and (pair? pair)
  2670. (string? (car pair))
  2671. (string? (cdr pair))
  2672. (<= 1 (string-length (car pair)))
  2673. (<= 1 (string-length (cdr pair))))
  2674. #t
  2675. #f))))
  2676. (define* (variable->string var #:key (append "") (postpend " "))
  2677. (let ((var (if (number? var)
  2678. (number->string var)
  2679. var)))
  2680. (if var
  2681. (string-append append var postpend)
  2682. "")))
  2683. ;; this procedure takes in one argument.
  2684. ;; if that argument is an <opensmtpd-table> whose fieldname 'values' is an assoc-list, then it returns
  2685. ;; #t, #f if otherwise.
  2686. (define (table-whose-data-are-assoc-list? table)
  2687. (if (not (opensmtpd-table? table))
  2688. #f
  2689. (assoc-list? (opensmtpd-table-data table))))
  2690. ;; this procedure takes in one argument
  2691. ;; if that argument is an <opensmtpd-table> whose fieldname 'values' is a list of strings, then it returns
  2692. ;; #t, #f if otherwise.
  2693. (define (table-whose-data-are-a-list-of-strings? table)
  2694. (if (not (opensmtpd-table? table))
  2695. #f
  2696. (list-of-strings? (opensmtpd-table-data table))))
  2697. ;;; The following functions convert various records into strings.
  2698. ;; these next few functions help me to turn <table>s
  2699. ;; into strings suitable to fit into "opensmtpd.conf".
  2700. (define (assoc-list->string assoc-list)
  2701. (string-drop-right
  2702. (let loop ((assoc-list assoc-list))
  2703. (if (null? assoc-list)
  2704. ""
  2705. ;; pair is (cons "hello" "world") -> ("hello" . "world")
  2706. (let ((pair (car assoc-list)))
  2707. (string-append
  2708. "\"" (car pair) "\""
  2709. " = "
  2710. "\"" (cdr pair) "\""
  2711. ", "
  2712. (loop (cdr assoc-list))))))
  2713. 2))
  2714. ;; can be of type: (quote list-of-strings) or (quote assoc-list)
  2715. ;; this will output a string that looks like:
  2716. ;; table <"mytable"> { "ludo"="ludo@gnu.org" }
  2717. (define (opensmtpd-table->string table)
  2718. (string-append "table \"" (opensmtpd-table-name table) "\" "
  2719. (cond ((table-whose-data-are-a-list-of-strings? table)
  2720. (string-append "{ "
  2721. (list-of-strings->string
  2722. (opensmtpd-table-data table)
  2723. #:append "\""
  2724. #:drop-right-number 3
  2725. #:postpend "\"") " }"))
  2726. ((table-whose-data-are-assoc-list? table)
  2727. (string-append "{ " (assoc-list->string (opensmtpd-table-data table)) " }"))
  2728. (else (throw 'youMessedUp table)))
  2729. " \n"))
  2730. ;; will output something like:
  2731. ;; <"mytable">
  2732. (define (opensmtpd-table-name->string table)
  2733. (string-append "<\"" (opensmtpd-table-name table) "\">"))
  2734. (define (opensmtpd-interface->string record)
  2735. (string-append "listen on "
  2736. (opensmtpd-interface-interface record) " "
  2737. (let* ((hostname (opensmtpd-interface-hostname record))
  2738. (hostnames (if (opensmtpd-interface-hostnames record)
  2739. (opensmtpd-table-name (opensmtpd-interface-hostnames record))
  2740. #f))
  2741. (filters (opensmtpd-interface-filters record))
  2742. (filter-name (if filters
  2743. (if (< 1 (length filters))
  2744. (generate-filter-chain-name filters)
  2745. (if (opensmtpd-filter? (car filters))
  2746. (opensmtpd-filter-name (car filters))
  2747. (opensmtpd-filter-phase-name (car filters))))
  2748. #f))
  2749. (mask-src (opensmtpd-interface-mask-src record))
  2750. (tag (opensmtpd-interface-tag record))
  2751. (secure-connection (opensmtpd-interface-secure-connection record))
  2752. (port (opensmtpd-interface-port record))
  2753. (pki (opensmtpd-interface-pki record))
  2754. (auth (opensmtpd-interface-auth record))
  2755. (auth-optional (opensmtpd-interface-auth-optional record)))
  2756. (string-append
  2757. (if mask-src
  2758. (string-append "mask-src ")
  2759. "")
  2760. (variable->string hostname #:append "hostname ")
  2761. (variable->string hostnames #:append "hostnames <" #:postpend "> ")
  2762. (variable->string filter-name #:append "filter \"" #:postpend "\" ")
  2763. (variable->string tag #:append "tag \"" #:postpend "\" ")
  2764. (if secure-connection
  2765. (cond ((string=? "smtps" secure-connection)
  2766. "smtps ")
  2767. ((string=? "tls" secure-connection)
  2768. "tls ")
  2769. ((string=? "tls-require" secure-connection)
  2770. "tls-require ")
  2771. ((string=? "tls-require-verify" secure-connection)
  2772. "tls-require verify "))
  2773. "")
  2774. (variable->string port #:append "port " #:postpend " ")
  2775. (if pki
  2776. (variable->string (opensmtpd-pki-domain pki) #:append "pki ")
  2777. "")
  2778. (if auth
  2779. (string-append "auth "
  2780. (if (opensmtpd-table? auth)
  2781. (opensmtpd-table-name->string auth)
  2782. ""))
  2783. "")
  2784. (if auth-optional
  2785. (string-append "auth-optional "
  2786. (if (opensmtpd-table? auth-optional)
  2787. (opensmtpd-table-name->string auth-optional)
  2788. ""))
  2789. "")
  2790. "\n"))))
  2791. (define (opensmtpd-socket->string record)
  2792. (string-append "listen on socket "
  2793. (let* ((filters (opensmtpd-socket-filters record))
  2794. (filter-name (if filters
  2795. (if (< 1 (length filters))
  2796. (generate-filter-chain-name filters)
  2797. (if (opensmtpd-filter? (car filters))
  2798. (opensmtpd-filter-name (car filters))
  2799. (opensmtpd-filter-phase-name (car filters))))
  2800. #f))
  2801. (mask-src (opensmtpd-socket-mask-src record))
  2802. (tag (opensmtpd-socket-tag record)))
  2803. (string-append
  2804. (if mask-src
  2805. (string-append "mask-src ")
  2806. "")
  2807. (variable->string filter-name #:append "filter \"" #:postpend "\" ")
  2808. (variable->string tag #:append "tag \"" #:postpend "\" ")
  2809. "\n"))))
  2810. (define (opensmtpd-relay->string record)
  2811. (let ((backup (opensmtpd-relay-backup record))
  2812. (backup-mx (opensmtpd-relay-backup-mx record))
  2813. (helo (opensmtpd-relay-helo record))
  2814. ;; helo-src can either be a string IP address or an <opensmtpd-table>
  2815. (helo-src (if (opensmtpd-relay-helo-src record)
  2816. (if (string? (opensmtpd-relay-helo-src record))
  2817. (opensmtpd-relay-helo-src record)
  2818. (string-append "<\""
  2819. (opensmtpd-table-name
  2820. (opensmtpd-relay-src record))
  2821. "\">"))
  2822. #f))
  2823. (domain (if (opensmtpd-relay-domain record)
  2824. (opensmtpd-table-name
  2825. (opensmtpd-relay-domain record))
  2826. #f))
  2827. (host (opensmtpd-relay-host record))
  2828. (name (opensmtpd-relay-name record))
  2829. (pki (if (opensmtpd-relay-pki record)
  2830. (opensmtpd-pki-domain (opensmtpd-relay-pki record))
  2831. #f))
  2832. (srs (opensmtpd-relay-srs record))
  2833. (tls (opensmtpd-relay-tls record))
  2834. (auth (if (opensmtpd-relay-auth record)
  2835. (opensmtpd-table-name
  2836. (opensmtpd-relay-auth record))
  2837. #f))
  2838. (mail-from (opensmtpd-relay-mail-from record))
  2839. ;; src can either be a string IP address or an <opensmtpd-table>
  2840. (src (if (opensmtpd-relay-src record)
  2841. (if (string? (opensmtpd-relay-src record))
  2842. (opensmtpd-relay-src record)
  2843. (string-append "<\""
  2844. (opensmtpd-table-name
  2845. (opensmtpd-relay-src record))
  2846. "\">"))
  2847. #f)))
  2848. (string-append
  2849. "\""
  2850. name
  2851. "\" " "relay "
  2852. ;;FIXME should I always quote the host fieldname? do I need to quote localhost via "localhost" ?
  2853. (variable->string host #:append "host \"" #:postpend "\" ")
  2854. (variable->string backup)
  2855. (variable->string backup-mx #:append "backup mx ")
  2856. (variable->string helo #:append "helo ")
  2857. (variable->string helo-src #:append "helo-src ")
  2858. (variable->string domain #:append "domain <\"" #:postpend "\"> ")
  2859. (variable->string host #:append "host ")
  2860. (variable->string pki #:append "pki ")
  2861. (variable->string srs)
  2862. (variable->string tls #:append "tls ")
  2863. (variable->string auth #:append "auth <\"" #:postpend "\"> ")
  2864. (variable->string mail-from #:append "mail-from ")
  2865. (variable->string src #:append "src ")
  2866. "\n")))
  2867. (define (opensmtpd-lmtp->string record)
  2868. (string-append "lmtp "
  2869. (opensmtpd-lmtp-destination record)
  2870. (if (opensmtpd-lmtp-rcpt-to record)
  2871. (begin
  2872. " " (opensmtpd-lmtp-rcpt-to record))
  2873. "")))
  2874. (define (opensmtpd-mda->string record)
  2875. (string-append "mda "
  2876. (opensmtpd-mda-command record) " "))
  2877. (define (opensmtpd-maildir->string record)
  2878. (string-append "maildir "
  2879. "\""
  2880. (if (opensmtpd-maildir-pathname record)
  2881. (opensmtpd-maildir-pathname record)
  2882. "~/Maildir")
  2883. "\""
  2884. (if (opensmtpd-maildir-junk record)
  2885. " junk "
  2886. " ")))
  2887. (define (opensmtpd-local-delivery->string record)
  2888. (let ((name (opensmtpd-local-delivery-name record))
  2889. (method (opensmtpd-local-delivery-method record))
  2890. (alias (if (opensmtpd-local-delivery-alias record)
  2891. (opensmtpd-table-name
  2892. (opensmtpd-local-delivery-alias record))
  2893. #f))
  2894. (ttl (opensmtpd-local-delivery-ttl record))
  2895. (user (opensmtpd-local-delivery-user record))
  2896. (userbase (if (opensmtpd-local-delivery-userbase record)
  2897. (opensmtpd-table-name
  2898. (opensmtpd-local-delivery-userbase record))
  2899. #f))
  2900. (virtual (if (opensmtpd-local-delivery-virtual record)
  2901. (opensmtpd-table-name
  2902. (opensmtpd-local-delivery-virtual record))
  2903. #f))
  2904. (wrapper (opensmtpd-local-delivery-wrapper record)))
  2905. (string-append
  2906. "\"" name "\" "
  2907. (cond ((string? method)
  2908. (string-append method " "))
  2909. ((opensmtpd-mda? method)
  2910. (opensmtpd-mda->string method))
  2911. ((opensmtpd-lmtp? method)
  2912. (opensmtpd-lmtp->string method))
  2913. ((opensmtpd-maildir? method)
  2914. (opensmtpd-maildir->string method)))
  2915. ;; FIXME/TODO support specifying alias file:/path/to/alias-file ?
  2916. ;; I do not think that is something that I can do...
  2917. (variable->string alias #:append "alias <\"" #:postpend "\"> ")
  2918. (variable->string ttl #:append "ttl ")
  2919. (variable->string user #:append "user ")
  2920. (variable->string userbase #:append "userbase <\"" #:postpend "\"> ")
  2921. (variable->string virtual #:append "virtual <\"" #:postpend "\"> ")
  2922. (variable->string wrapper #:append "wrapper "))))
  2923. ;; this function turns both opensmtpd-local-delivery and
  2924. ;; opensmtpd-relay into strings.
  2925. (define (opensmtpd-action->string record)
  2926. (string-append "action "
  2927. (cond ((opensmtpd-local-delivery? record)
  2928. (opensmtpd-local-delivery->string record))
  2929. ((opensmtpd-relay? record)
  2930. (opensmtpd-relay->string record)))
  2931. " \n"))
  2932. ;; this turns option records found in <opensmtpd-match> into strings.
  2933. (define* (opensmtpd-option->string record
  2934. #:key
  2935. (space-after-! #f))
  2936. (let ((not (opensmtpd-option-not record))
  2937. (option (opensmtpd-option-option record))
  2938. (regex (opensmtpd-option-regex record))
  2939. (data (opensmtpd-option-data record)))
  2940. (string-append
  2941. (if not
  2942. (if space-after-!
  2943. "! "
  2944. "!")
  2945. "")
  2946. option " "
  2947. (if regex
  2948. "regex "
  2949. "")
  2950. (if data
  2951. (if (opensmtpd-table? data)
  2952. (string-append
  2953. (opensmtpd-table-name->string data) " ")
  2954. (string-append data " "))
  2955. ""))))
  2956. (define (opensmtpd-match->string record)
  2957. (string-append "match "
  2958. (let* ((action (opensmtpd-match-action record))
  2959. (name (cond ((opensmtpd-relay? action)
  2960. (opensmtpd-relay-name action))
  2961. ((opensmtpd-local-delivery? action)
  2962. (opensmtpd-local-delivery-name action))
  2963. (else 'reject)))
  2964. (options (opensmtpd-match-options record)))
  2965. (string-append
  2966. (if options
  2967. (apply string-append
  2968. (map opensmtpd-option->string options))
  2969. "")
  2970. (if (string? name)
  2971. (string-append "action " "\"" name "\" ")
  2972. "reject ")
  2973. "\n"))))
  2974. (define (opensmtpd-ca->string record)
  2975. (string-append "ca " (opensmtpd-ca-name record) " "
  2976. "cert \"" (opensmtpd-ca-file record) "\"\n"))
  2977. (define (opensmtpd-pki->string record)
  2978. (let ((domain (opensmtpd-pki-domain record))
  2979. (cert (opensmtpd-pki-cert record))
  2980. (key (opensmtpd-pki-key record))
  2981. (dhe (opensmtpd-pki-dhe record)))
  2982. (string-append "pki " domain " " "cert \"" cert "\" \n"
  2983. "pki " domain " " "key \"" key "\" \n"
  2984. (if dhe
  2985. (string-append
  2986. "pki " domain " " "dhe " dhe "\n")
  2987. ""))))
  2988. (define (generate-filter-chain-name list-of-filters)
  2989. (string-drop-right (apply string-append
  2990. (flatten
  2991. (map (lambda (filter)
  2992. (list
  2993. (if (opensmtpd-filter? filter)
  2994. (opensmtpd-filter-name filter)
  2995. (opensmtpd-filter-phase-name filter))
  2996. "-"))
  2997. list-of-filters)))
  2998. 1))
  2999. (define (opensmtpd-filter->list-of-strings-and-gexps record)
  3000. (list "filter "
  3001. "\"" (opensmtpd-filter-name record) "\" "
  3002. (if (opensmtpd-filter-exec record)
  3003. "proc-exec "
  3004. "proc ")
  3005. "\"" (opensmtpd-filter-proc record) "\""
  3006. "\n\n"))
  3007. ;; this procedure takes in a list of <opensmtpd-filter> and <opensmtpd-filter-phase>,
  3008. ;; returns a string of the form:
  3009. ;; filter "uniquelyGeneratedName" chain chain { "filter-name", "filter-name2" [, ...]}
  3010. (define (opensmtpd-filter-chain->string list-of-filters)
  3011. (string-append "filter \""
  3012. (generate-filter-chain-name list-of-filters)
  3013. "\" "
  3014. "chain {"
  3015. (string-drop-right
  3016. (apply string-append
  3017. (flatten
  3018. (map (lambda (filter)
  3019. (list
  3020. "\""
  3021. (if (opensmtpd-filter? filter)
  3022. (opensmtpd-filter-name filter)
  3023. (opensmtpd-filter-phase-name filter))
  3024. "\", "))
  3025. list-of-filters)))
  3026. 2)
  3027. "}\n\n"))
  3028. (define (opensmtpd-filter-phase->string record)
  3029. (let ((name (opensmtpd-filter-phase-name record))
  3030. (phase (opensmtpd-filter-phase-phase record))
  3031. (decision (opensmtpd-filter-phase-decision record))
  3032. (options (opensmtpd-filter-phase-options record))
  3033. (message (opensmtpd-filter-phase-message record))
  3034. (value (opensmtpd-filter-phase-value record)))
  3035. (string-append "filter "
  3036. "\"" name "\" "
  3037. "phase " phase " "
  3038. "match "
  3039. (apply string-append ; turn the options into a string
  3040. (flatten
  3041. (map (lambda (option)
  3042. (opensmtpd-option->string option #:space-after-! #f))
  3043. options)))
  3044. " "
  3045. decision " "
  3046. (if (member decision (list "reject" "disconnect"))
  3047. (string-append "\"" message "\"")
  3048. "")
  3049. (if (string=? "rewrite" decision)
  3050. (string-append "rewrite " (number->string value))
  3051. "")
  3052. "\n\n")))
  3053. ;; in the next procedure, the variable 'filters' is a list of
  3054. ;; <opensmtpd-filter>, <opensmtpd-filter-phase>, and filter chains, which are
  3055. ;; lists that look like:
  3056. ;; (list (opensmtpd-filter ...) (opensmtpd-filter-phase ...)
  3057. ;; (opensmtpd-filter-phase ...) (opensmtpd-filter ...)
  3058. ;; This function converts (get-opensmtpd-filters <opensmtpd-configuration>) to a string.
  3059. ;; Consider if a user passed in a valid <opensmtpd-configuration>,
  3060. ;; so that (get-opensmtpd-filters (opensmtpd-configuration)) returns
  3061. ;; (list (opensmtpd-filter
  3062. ;; (name "rspamd")
  3063. ;; (proc "rspamd"))
  3064. ;; (list (opensmtpd-filter-phase ; this is a listen-on, with a filter-chain.
  3065. ;; (name "dkimsign")
  3066. ;; ...)
  3067. ;; (opensmtpd-filter
  3068. ;; (name "rspamd")
  3069. ;; (proc "rspamd"))))
  3070. ;;
  3071. ;; (we will call the above list "total filters"):
  3072. ;; did you notice that filter "rspamd" is listed twice? Once by itself, and once again
  3073. ;; in a filter chain. How do you make sure that it is NOT printed twice in smtpd.conf?
  3074. ;; 1st flatten "total filters", then remove its duplicates so that we may print the
  3075. ;; <opensmtpd-filter>s and <opensmtpd-filter-phase>s.
  3076. ;; 2nd now we go through "total filters", and we only print the filter-chains.
  3077. (define (opensmtpd-filters->list-of-strings-and-gexps filters)
  3078. ;; first print the unique <opensmtpd-filter-phase>s and <opensmtpd-filter>s.
  3079. ;; then print the filter-chains.
  3080. ;; to do this: flatten filters, then remove duplicates.
  3081. (append
  3082. (map (lambda (filter)
  3083. (cond ((opensmtpd-filter-phase? filter)
  3084. (opensmtpd-filter-phase->string filter))
  3085. ((opensmtpd-filter? filter)
  3086. (opensmtpd-filter->list-of-strings-and-gexps filter))
  3087. (else "")))
  3088. (delete-duplicates (flatten filters)))
  3089. ;; now we have to print the filter chains.
  3090. (apply string-append
  3091. (map (lambda (filter)
  3092. (cond ((list? filter)
  3093. (opensmtpd-filter-chain->string filter))
  3094. (else ; you are a <opensmtpd-filter>
  3095. "")))
  3096. filters))))
  3097. (define (opensmtpd-configuration-includes->string string)
  3098. (string-append
  3099. "include \"" string "\"\n"))
  3100. (define (opensmtpd-configuration-srs->string record)
  3101. (let ((key (opensmtpd-srs-key record))
  3102. (backup-key (opensmtpd-srs-backup-key record))
  3103. (ttl-delay (opensmtpd-srs-ttl-delay record)))
  3104. (string-append
  3105. (variable->string key #:append "srs key " #:postpend "\n")
  3106. (variable->string backup-key #:append "srs key backup " #:postpend "\n")
  3107. (variable->string ttl-delay #:append "srs ttl " #:postpend "\n")
  3108. "\n")))
  3109. ;; TODO make sure all options here work! I just fixed limit-max-rcpt!
  3110. (define (opensmtpd-smtp->string record)
  3111. (let ((ciphers (opensmtpd-smtp-ciphers record))
  3112. (limit-max-mails (opensmtpd-smtp-limit-max-mails record))
  3113. (limit-max-rcpt (opensmtpd-smtp-limit-max-rcpt record))
  3114. (max-message-size (opensmtpd-smtp-max-message-size record))
  3115. (sub-addr-delim (opensmtpd-smtp-sub-addr-delim record)))
  3116. (string-append
  3117. (variable->string ciphers #:append "smtp ciphers " #:postpend "\n")
  3118. (variable->string limit-max-mails #:append "smtp limit max-mails " #:postpend "\n")
  3119. (variable->string limit-max-rcpt #:append "smtp limit max-rcpt " #:postpend "\n")
  3120. (variable->string max-message-size #:append "smtp max-message-size " #:postpend "\n")
  3121. (variable->string sub-addr-delim #:append "smtp sub-addr-delim " #:postpend "\n")
  3122. "\n")))
  3123. (define (opensmtpd-configuration-queue->string record)
  3124. (let ((compression (opensmtpd-queue-compression record))
  3125. (encryption (opensmtpd-queue-encryption record))
  3126. (ttl-delay (opensmtpd-queue-ttl-delay record)))
  3127. (string-append
  3128. (if compression
  3129. "queue compression\n"
  3130. "")
  3131. (if encryption
  3132. (string-append
  3133. "queue encryption "
  3134. (if (not (boolean? encryption))
  3135. encryption
  3136. "")
  3137. "\n")
  3138. "")
  3139. (if ttl-delay
  3140. (string-append "queue ttl" ttl-delay "\n")
  3141. ""))))
  3142. ;; build a list of <opensmtpd-action> from
  3143. ;; opensmtpd-configuration-matches, which is a list of <opensmtpd-match>.
  3144. ;; Each <opensmtpd-match> has a fieldname 'action', which accepts an <opensmtpd-action>.
  3145. (define (get-opensmtpd-actions record)
  3146. (define opensmtpd-actions
  3147. (let loop ((list (opensmtpd-configuration-matches record)))
  3148. (if (null? list)
  3149. '()
  3150. (cons (opensmtpd-match-action (car list))
  3151. (loop (cdr list))))))
  3152. (delete-duplicates (append opensmtpd-actions)))
  3153. ;; build a list of opensmtpd-pkis from
  3154. ;; opensmtpd-configuration-interfaces and
  3155. ;; get-opensmtpd-actions
  3156. (define (get-opensmtpd-pkis record)
  3157. ;; TODO/FIXME/maybe/wishlist could get-opensmtpd-actions -> NOT have an opensmtpd-relay?
  3158. ;; I think so. And if it did NOT have a relay configuration, then action-pkis would be '() when
  3159. ;; it needs to be #f. because if the opensmtpd-configuration has NO pkis, then this function will
  3160. ;; return '(), when it should return #f. If it returns '(), then opensmtpd-configuration-fieldname->string will
  3161. ;; print the string "\n" instead of ""
  3162. (define action-pkis
  3163. (let loop1 ((list (get-opensmtpd-actions record)))
  3164. (if (null? list)
  3165. '()
  3166. (if (and (opensmtpd-relay? (car list))
  3167. (opensmtpd-relay-pki (car list)))
  3168. (cons (opensmtpd-relay-pki (car list))
  3169. (loop1 (cdr list)))
  3170. (loop1 (cdr list))))))
  3171. ;; FIXME/TODO/maybe/wishlist
  3172. ;; this could be #f aka left blank. aka there are no interface records with pkis.
  3173. ;; aka there are no lines in the configuration like:
  3174. ;; listen on eth0 tls pki smtp.gnucode.me in that case the smtpd.conf will have an extra "\n"
  3175. (define listen-on-pkis
  3176. (let loop2 ((list (opensmtpd-configuration-interfaces record)))
  3177. (if (null? list)
  3178. '()
  3179. (if (opensmtpd-interface-pki (car list))
  3180. (cons (opensmtpd-interface-pki (car list))
  3181. (loop2 (cdr list)))
  3182. (loop2 (cdr list))))))
  3183. (delete-duplicates (append action-pkis listen-on-pkis)))
  3184. ;; takes in a <opensmtpd-configuration> and returns a list whose elements are <opensmtpd-filter>,
  3185. ;; <opensmtpd-filter-phase>, and a filter-chain.
  3186. ;; It returns a list of <opensmtpd-filter> and/or <opensmtpd-filter-phase>
  3187. ;; here's an example of what this procedure might return:
  3188. ;; (list (opensmtpd-filter...) (opensmtpd-filter-phase ...)
  3189. ;; (openmstpd-filter ...) (opensmtpd-filter-phase ...)
  3190. ;; ;; this next list is a filter-chain.
  3191. ;; (list (opensmtpd-filter-phase ...) (opensmtpd-filter...)))
  3192. ;;
  3193. ;; This procedure handles filter chains a little odd.
  3194. (define (get-opensmtpd-filters record)
  3195. (define socket-filters
  3196. (if (and (opensmtpd-configuration-socket record)
  3197. (opensmtpd-socket-filters (opensmtpd-configuration-socket record)))
  3198. (opensmtpd-socket-filters (opensmtpd-configuration-socket record))
  3199. '()))
  3200. (define list-of-interfaces
  3201. (if (opensmtpd-configuration-interfaces record)
  3202. (opensmtpd-configuration-interfaces record)
  3203. '()))
  3204. (delete-duplicates
  3205. (append
  3206. (remove boolean?
  3207. (map-in-order (lambda (interface-or-socket-record) ; get the filters found in the <listen-on-record>s
  3208. (if (and (opensmtpd-interface-filters interface-or-socket-record)
  3209. (= 1 (length (opensmtpd-interface-filters
  3210. interface-or-socket-record))))
  3211. ;; this next line returns an <opensmtpd-interface>
  3212. (car (opensmtpd-interface-filters interface-or-socket-record))
  3213. ;; this next line returns a filter chain.
  3214. (opensmtpd-interface-filters interface-or-socket-record)))
  3215. list-of-interfaces))
  3216. socket-filters)))
  3217. (define (flatten . lst)
  3218. "Return a list that recursively concatenates all sub-lists of LST."
  3219. (define (flatten1 head out)
  3220. (if (list? head)
  3221. (fold-right flatten1 out head)
  3222. (cons head out)))
  3223. (fold-right flatten1 '() lst))
  3224. ;; This function takes in a record, or list, or anything, and returns
  3225. ;; a list of <opensmtpd-table>s assuming the thing you passed into it had
  3226. ;; any <opensmtpd-table>s.
  3227. ;;
  3228. ;; is object record? call func on it's fieldnames
  3229. ;; is object list? loop through it's fieldnames calling func on it's records
  3230. ;; is object #f or string? or '()? -> #f
  3231. (define (get-opensmtpd-tables value)
  3232. (delete-duplicates
  3233. (remove boolean? (flatten ;; turn (list '(1) '(2 '(3))) -> '(1 2 3)
  3234. (cond ((opensmtpd-table? value)
  3235. value)
  3236. ((record? value)
  3237. (let* ((record-type (record-type-descriptor value))
  3238. (list-of-record-fieldnames (record-type-fields record-type)))
  3239. (map (lambda (fieldname)
  3240. (get-opensmtpd-tables ((record-accessor record-type fieldname) value)))
  3241. list-of-record-fieldnames)))
  3242. ((and (list? value) (not (null? value)))
  3243. (map get-opensmtpd-tables value))
  3244. (else #f))))))
  3245. (define (opensmtpd-configuration-fieldname->string record fieldname-accessor record->string)
  3246. (if (fieldname-accessor record)
  3247. (begin
  3248. (string-append
  3249. (list-of-records->string (fieldname-accessor record) record->string) "\n"))
  3250. ""))
  3251. (define (list-of-records->string list-of-records record->string)
  3252. (string-append
  3253. (cond ((not (list? list-of-records))
  3254. (record->string list-of-records))
  3255. (else
  3256. (let loop ((list list-of-records))
  3257. (if (null? list)
  3258. ""
  3259. (string-append
  3260. (record->string (car list))
  3261. (loop (cdr list)))))))))
  3262. (define (opensmtpd-configuration->string record)
  3263. ;; should I use this named let, or should I give this a name, or not use it at all...
  3264. ;; eg: (write-all-fieldnames (list (cons fieldname fieldname->string) (cons fieldname2 fieldname->string)))
  3265. ;; (let loop ([list (list (cons opensmtpd-configuration-includes (lambda (string)
  3266. ;; (string-append
  3267. ;; "include \"" string "\"\n")))
  3268. ;; (cons opensmtpd-configuration-smtp opensmtpd-smtp->string)
  3269. ;; (cons opensmtpd-configuration-srs opensmtpd-srs->string))])
  3270. ;; (if (null? list)
  3271. ;; ""
  3272. ;; (string-append (opensmtpd-configuration-fieldname->string record
  3273. ;; (caar list)
  3274. ;; (cdar list))
  3275. ;; (loop (cdr list)))))
  3276. (string-append
  3277. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-bounce
  3278. (lambda (%bounce)
  3279. (if %bounce
  3280. (list-of-strings->string %bounce)
  3281. "")))
  3282. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-smtp
  3283. opensmtpd-smtp->string)
  3284. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-srs
  3285. opensmtpd-configuration-srs->string)
  3286. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-queue
  3287. opensmtpd-configuration-queue->string)
  3288. ;; write out the mta-max-deferred
  3289. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-mta-max-deferred
  3290. (lambda (var)
  3291. (string-append "mta max-deferred "
  3292. (number->string (opensmtpd-configuration-mta-max-deferred record)) "\n")))
  3293. ;;write out all the tables
  3294. (opensmtpd-configuration-fieldname->string record get-opensmtpd-tables opensmtpd-table->string)
  3295. ;; write out all the cas
  3296. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-cas opensmtpd-ca->string)
  3297. ;; write out all the pkis
  3298. (opensmtpd-configuration-fieldname->string record get-opensmtpd-pkis opensmtpd-pki->string)
  3299. ;; write all of the listen-on-records
  3300. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-interfaces
  3301. opensmtpd-interface->string)
  3302. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-socket
  3303. opensmtpd-socket->string)
  3304. ;; write all the actions
  3305. (opensmtpd-configuration-fieldname->string record get-opensmtpd-actions
  3306. opensmtpd-action->string)
  3307. ;; write all of the matches
  3308. (opensmtpd-configuration-fieldname->string record opensmtpd-configuration-matches opensmtpd-match->string)))
  3309. ;; FIXME/TODO should I use format here srfi-28 ?
  3310. ;; web.scm nginx does a (format #f "string" "another string")
  3311. ;; this could be a list like (list (file-append opensmtpd-dkimsign "/libexec/filter") "-d gnucode.me -s /path/to/selector.cert")
  3312. ;; Then opensmtpd-configuration->mixed-text-file could be rewritten to be something like
  3313. ;; (mixed-text-file (eval `(string-append (opensmtpd-configuration-fieldname->string ...)) (gnu services mail)))
  3314. (define (opensmtpd-configuration->mixed-text-file record)
  3315. (apply mixed-text-file "smtpd.conf"
  3316. (flatten (list
  3317. ;; write out the includes
  3318. (opensmtpd-configuration-fieldname->string
  3319. record
  3320. opensmtpd-configuration-includes
  3321. opensmtpd-configuration-includes->string)
  3322. ;; TODO should I change the below line of code into these two lines of code?
  3323. ;;(opensmtpd-configuration-fieldname->string record get-opensmtpd-filters-and-filter-phases opensmtpd-filter-and-filter-phase->string)
  3324. ;;(opensmtpd-configuration-fieldname->string record get-opensmtpd-filter-chains opensmtpd-filter-chain->string)
  3325. ;; write out all the filters
  3326. (opensmtpd-filters->list-of-strings-and-gexps (get-opensmtpd-filters record))
  3327. (opensmtpd-configuration->string record)))))
  3328. (define %default-opensmtpd-config-file
  3329. (plain-file "smtpd.conf" "
  3330. listen on lo
  3331. action inbound mbox
  3332. match for local action inbound
  3333. action outbound relay
  3334. match from local for any action outbound
  3335. "))
  3336. (define (opensmtpd-shepherd-service config)
  3337. (match-lambda
  3338. (($ <opensmtpd-configuration> package config-file)
  3339. (list (shepherd-service
  3340. (provision '(smtpd))
  3341. (requirement '(loopback))
  3342. (documentation "Run the OpenSMTPD daemon.")
  3343. (start (let ((smtpd (file-append package "/sbin/smtpd")))
  3344. #~(make-forkexec-constructor
  3345. (list #$smtpd "-f" (or #$config-file
  3346. #$(opensmtpd-configuration->mixed-text-file config)))
  3347. #:pid-file "/var/run/smtpd.pid")))
  3348. (stop #~(make-kill-destructor)))))))
  3349. (define %opensmtpd-accounts
  3350. (list (user-group
  3351. (name "smtpq")
  3352. (system? #t))
  3353. (user-account
  3354. (name "smtpd")
  3355. (group "nogroup")
  3356. (system? #t)
  3357. (comment "SMTP Daemon")
  3358. (home-directory "/var/empty")
  3359. (shell (file-append shadow "/sbin/nologin")))
  3360. (user-account
  3361. (name "smtpq")
  3362. (group "smtpq")
  3363. (system? #t)
  3364. (comment "SMTPD Queue")
  3365. (home-directory "/var/empty")
  3366. (shell (file-append shadow "/sbin/nologin")))))
  3367. (define (opensmtpd-activation config)
  3368. (match-lambda
  3369. (($ <opensmtpd-configuration> package config-file)
  3370. (let ((smtpd (file-append package "/sbin/smtpd"))
  3371. (configuration (opensmtpd-configuration->mixed-text-file config)))
  3372. #~(begin
  3373. (use-modules (guix build utils))
  3374. ;; Create mbox and spool directories.
  3375. (mkdir-p "/var/mail")
  3376. (mkdir-p "/var/spool/smtpd")
  3377. (chmod "/var/spool/smtpd" #o711)
  3378. (mkdir-p "/var/spool/mail")
  3379. (chmod "/var/spool/mail" #o711)
  3380. (display (string-append "checking syntax of "
  3381. (or
  3382. #$config-file
  3383. #$configuration)
  3384. "\n")))))))
  3385. (define %opensmtpd-pam-services
  3386. (list (unix-pam-service "smtpd")))
  3387. (define opensmtpd-set-gids
  3388. (match-lambda
  3389. (($ <opensmtpd-configuration> package config-file set-gids?)
  3390. (if set-gids?
  3391. (list
  3392. (setuid-program
  3393. (program (file-append package "/sbin/smtpctl"))
  3394. (setuid? #false)
  3395. (setgid? #true)
  3396. (group "smtpq"))
  3397. (setuid-program
  3398. (program (file-append package "/sbin/sendmail"))
  3399. (setuid? #false)
  3400. (setgid? #true)
  3401. (group "smtpq"))
  3402. (setuid-program
  3403. (program (file-append package "/sbin/send-mail"))
  3404. (setuid? #false)
  3405. (setgid? #true)
  3406. (group "smtpq"))
  3407. (setuid-program
  3408. (program (file-append package "/sbin/makemap"))
  3409. (setuid? #false)
  3410. (setgid? #true)
  3411. (group "smtpq"))
  3412. (setuid-program
  3413. (program (file-append package "/sbin/mailq"))
  3414. (setuid? #false)
  3415. (setgid? #true)
  3416. (group "smtpq"))
  3417. (setuid-program
  3418. (program (file-append package "/sbin/newaliases"))
  3419. (setuid? #false)
  3420. (setgid? #true)
  3421. (group "smtpq")))
  3422. '()))))
  3423. (define opensmtpd-service-type
  3424. (service-type
  3425. (name 'opensmtpd)
  3426. (extensions
  3427. (list (service-extension account-service-type
  3428. (const %opensmtpd-accounts))
  3429. (service-extension activation-service-type
  3430. opensmtpd-activation)
  3431. (service-extension pam-root-service-type
  3432. (const %opensmtpd-pam-services))
  3433. (service-extension profile-service-type
  3434. (compose list opensmtpd-configuration-package))
  3435. (service-extension shepherd-root-service-type
  3436. opensmtpd-shepherd-service)
  3437. (service-extension setuid-program-service-type
  3438. opensmtpd-set-gids)))
  3439. (description "Run the OpenSMTPD, a lightweight @acronym{SMTP, Simple Mail
  3440. Transfer Protocol} server.")))
  3441. ;;;
  3442. ;;; mail aliases.
  3443. ;;;
  3444. (define (mail-aliases-etc aliases)
  3445. `(("aliases" ,(plain-file "aliases"
  3446. ;; Ideally we'd use a format string like
  3447. ;; "~:{~a: ~{~a~^,~}\n~}", but it gives a
  3448. ;; warning that I can't figure out how to fix,
  3449. ;; so we'll just use string-join below instead.
  3450. (format #f "~:{~a: ~a\n~}"
  3451. (map (match-lambda
  3452. ((alias addresses ...)
  3453. (list alias (string-join addresses ","))))
  3454. aliases))))))
  3455. (define mail-aliases-service-type
  3456. (service-type
  3457. (name 'mail-aliases)
  3458. (extensions
  3459. (list (service-extension etc-service-type mail-aliases-etc)))
  3460. (compose concatenate)
  3461. (extend append)
  3462. (description "Provide a @file{/etc/aliases} file---an email alias
  3463. database---computed from the given alias list.")))
  3464. ;;;
  3465. ;;; Exim.
  3466. ;;;
  3467. (define-record-type* <exim-configuration> exim-configuration
  3468. make-exim-configuration
  3469. exim-configuration?
  3470. (package exim-configuration-package ;file-like
  3471. (default exim))
  3472. (config-file exim-configuration-config-file ;file-like
  3473. (default #f)))
  3474. (define %exim-accounts
  3475. (list (user-group
  3476. (name "exim")
  3477. (system? #t))
  3478. (user-account
  3479. (name "exim")
  3480. (group "exim")
  3481. (system? #t)
  3482. (comment "Exim Daemon")
  3483. (home-directory "/var/empty")
  3484. (shell (file-append shadow "/sbin/nologin")))))
  3485. (define (exim-computed-config-file package config-file)
  3486. (computed-file "exim.conf"
  3487. #~(call-with-output-file #$output
  3488. (lambda (port)
  3489. (format port "
  3490. exim_user = exim
  3491. exim_group = exim
  3492. .include ~a"
  3493. #$(or config-file
  3494. (file-append package "/etc/exim.conf")))))))
  3495. (define exim-shepherd-service
  3496. (match-lambda
  3497. (($ <exim-configuration> package config-file)
  3498. (list (shepherd-service
  3499. (provision '(exim mta))
  3500. (documentation "Run the exim daemon.")
  3501. (requirement '(networking))
  3502. (start #~(make-forkexec-constructor
  3503. '(#$(file-append package "/bin/exim")
  3504. "-bd" "-v" "-C"
  3505. #$(exim-computed-config-file package config-file))))
  3506. (stop #~(make-kill-destructor)))))))
  3507. (define exim-activation
  3508. (match-lambda
  3509. (($ <exim-configuration> package config-file)
  3510. (with-imported-modules '((guix build utils))
  3511. #~(begin
  3512. (use-modules (guix build utils))
  3513. (let ((uid (passwd:uid (getpw "exim")))
  3514. (gid (group:gid (getgr "exim"))))
  3515. (mkdir-p "/var/spool/exim")
  3516. (chown "/var/spool/exim" uid gid))
  3517. (zero? (system* #$(file-append package "/bin/exim")
  3518. "-bV" "-C" #$(exim-computed-config-file package config-file))))))))
  3519. (define exim-profile
  3520. (compose list exim-configuration-package))
  3521. (define exim-service-type
  3522. (service-type
  3523. (name 'exim)
  3524. (extensions
  3525. (list (service-extension shepherd-root-service-type exim-shepherd-service)
  3526. (service-extension account-service-type (const %exim-accounts))
  3527. (service-extension activation-service-type exim-activation)
  3528. (service-extension profile-service-type exim-profile)
  3529. (service-extension mail-aliases-service-type (const '()))))
  3530. (description "Run the Exim mail transfer agent (MTA).")))
  3531. ;;;
  3532. ;;; GNU Mailutils IMAP4 Daemon.
  3533. ;;;
  3534. (define %default-imap4d-config-file
  3535. (plain-file "imap4d.conf" "server localhost {};\n"))
  3536. (define-record-type* <imap4d-configuration>
  3537. imap4d-configuration make-imap4d-configuration imap4d-configuration?
  3538. (package imap4d-configuration-package
  3539. (default mailutils))
  3540. (config-file imap4d-configuration-config-file
  3541. (default %default-imap4d-config-file)))
  3542. (define imap4d-shepherd-service
  3543. (match-lambda
  3544. (($ <imap4d-configuration> package config-file)
  3545. (list (shepherd-service
  3546. (provision '(imap4d))
  3547. (requirement '(networking syslogd))
  3548. (documentation "Run the imap4d daemon.")
  3549. (start (let ((imap4d (file-append package "/sbin/imap4d")))
  3550. #~(make-forkexec-constructor
  3551. (list #$imap4d "--daemon" "--foreground"
  3552. "--config-file" #$config-file))))
  3553. (stop #~(make-kill-destructor)))))))
  3554. (define imap4d-service-type
  3555. (service-type
  3556. (name 'imap4d)
  3557. (description
  3558. "Run the GNU @command{imap4d} to serve e-mail messages through IMAP.")
  3559. (extensions
  3560. (list (service-extension
  3561. shepherd-root-service-type imap4d-shepherd-service)))
  3562. (default-value (imap4d-configuration))))
  3563. ;;;
  3564. ;;; Radicale.
  3565. ;;;
  3566. (define-record-type* <radicale-configuration>
  3567. radicale-configuration make-radicale-configuration
  3568. radicale-configuration?
  3569. (package radicale-configuration-package
  3570. (default radicale))
  3571. (config-file radicale-configuration-config-file
  3572. (default %default-radicale-config-file)))
  3573. (define %default-radicale-config-file
  3574. (plain-file "radicale.conf" "
  3575. [auth]
  3576. type = htpasswd
  3577. htpasswd_filename = /var/lib/radicale/users
  3578. htpasswd_encryption = plain
  3579. [server]
  3580. hosts = localhost:5232"))
  3581. (define %radicale-accounts
  3582. (list (user-group
  3583. (name "radicale")
  3584. (system? #t))
  3585. (user-account
  3586. (name "radicale")
  3587. (group "radicale")
  3588. (system? #t)
  3589. (comment "Radicale Daemon")
  3590. (home-directory "/var/empty")
  3591. (shell (file-append shadow "/sbin/nologin")))))
  3592. (define radicale-shepherd-service
  3593. (match-lambda
  3594. (($ <radicale-configuration> package config-file)
  3595. (list (shepherd-service
  3596. (provision '(radicale))
  3597. (documentation "Run the radicale daemon.")
  3598. (requirement '(networking))
  3599. (start #~(make-forkexec-constructor
  3600. (list #$(file-append package "/bin/radicale")
  3601. "-C" #$config-file)
  3602. #:user "radicale"
  3603. #:group "radicale"))
  3604. (stop #~(make-kill-destructor)))))))
  3605. (define radicale-activation
  3606. (match-lambda
  3607. (($ <radicale-configuration> package config-file)
  3608. (with-imported-modules '((guix build utils))
  3609. #~(begin
  3610. (use-modules (guix build utils))
  3611. (let ((uid (passwd:uid (getpw "radicale")))
  3612. (gid (group:gid (getgr "radicale"))))
  3613. (mkdir-p "/var/lib/radicale/collections")
  3614. (chown "/var/lib/radicale" uid gid)
  3615. (chown "/var/lib/radicale/collections" uid gid)
  3616. (chmod "/var/lib/radicale" #o700)))))))
  3617. (define radicale-service-type
  3618. (service-type
  3619. (name 'radicale)
  3620. (description "Run radicale, a small CalDAV and CardDAV server.")
  3621. (extensions
  3622. (list (service-extension shepherd-root-service-type radicale-shepherd-service)
  3623. (service-extension account-service-type (const %radicale-accounts))
  3624. (service-extension activation-service-type radicale-activation)))
  3625. (default-value (radicale-configuration))))