mail.scm 175 KB

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