From 96b28bc915573e2edc63aabc8d1df0b03b73a17c Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Mon, 10 Jan 2022 04:18:28 +0000 Subject: [PATCH] end of session commit -- middle of Chapter 13. --- profile.png | Bin 0 -> 14297 bytes rails-to-caveman.asd | 10 +- src/ch12.5.lisp | 132 +++++++ src/helpers.lisp | 119 ++++++ src/model.lisp | 228 +++++++---- src/rfc2616-sec10.lisp | 604 ++++++++++++++++++++++++++++++ src/storage.lisp | 73 ++++ src/web.lisp | 596 ++++++++++++++++++++++++++--- templates/accounts/edit.html | 3 +- templates/entries/footer.html | 3 +- templates/entries/show.html | 29 +- templates/entry-images/edit.html | 15 + templates/entry-images/form.html | 11 + templates/entry-images/index.html | 50 +++ templates/entry-images/new.html | 16 + templates/shared/user_form.html | 20 +- templates/users/body.html | 96 ++--- templates/users/edit.html | 2 +- templates/users/new.html | 3 +- 19 files changed, 1831 insertions(+), 179 deletions(-) create mode 100644 profile.png create mode 100644 src/ch12.5.lisp create mode 100644 src/helpers.lisp create mode 100644 src/rfc2616-sec10.lisp create mode 100644 src/storage.lisp create mode 100644 templates/entry-images/edit.html create mode 100644 templates/entry-images/form.html create mode 100644 templates/entry-images/index.html create mode 100644 templates/entry-images/new.html diff --git a/profile.png b/profile.png new file mode 100644 index 0000000000000000000000000000000000000000..d41c9c9afcf446ec19fcd1a5e9595b453345e931 GIT binary patch literal 14297 zcmYLwWmr^g*Y?aX#DH`w-Q6Nc4J`=LEnO-|cMctr(w)*JA<{!5AR*l#-6P%e&i(xO zz8`b!y^q<~+E=bP*SVt9-znl^KgR|D0JutTQAnFzfz`{UX-n*39pe_)nHwLZ% z01nZAKj5F0fCm784xl6_t?dOo&Vi&G>!h4|e$CX%P$Z%Y;sZa^!U`7V4pmbpv{siR zdC@9;9Dx65|8Nv=a9Fw$aD}j+jPR~z_>oUnSgVm75s4;*uV_O=9|R_n*%3`q{+)7- z%yCs)F-m#vu+n_293SQ(fjmhC&XdU(`ywP;t{aV28A^$Js$s?d+vg`(Cn7M?iH zg3XHE;5w*4y^DntYH0qoPQQ#;x!~R7ho%VzH^__7&oWtc3iG*QKMv*@FR)iy7*Bnd zV>jLS&Qj2>-28k5yv-Gd7!ff9E_|jUvgxc`M49Nxz+E{-6UB)UsD=|)3V{`tsy0?= z&NUT2)?w)Ho~a%dAUaS4^BX~Ta&Y-UB{HKmN()`ZB zj(fub>febQczvmR53h10U@#xQ6O1GQ4SED^fQHv?d(L|Tx|4&_)gi+^o1FM+_c;DZ zJkb-I{)&6uhhR3MJ4DVSZ46qX%zB#?HX8_T4<266H%mn|z!N~{BjX7V#>d~EEXBDv zaU|s-dPn+Ul;y%gCW?d|&Fdx`k$}jDrPLY0Ekvv&(VPq9P)!U6wtaoYuP!dmLtVqJ zA-0f2@7gp4>m2|#upsdLO${Qw&HyfeRm#bI0?9Hp;fl{h+STNl-jZKi_Bp4^2d7fGDCAy#@2w+gf@SdT?79bN!1BTmh^br(sJj zgVnDEnm+WR@tcdFIzi%j7Od8|0s`8u`i5BtCw5VJ$;jX5!Zw{kpvi^oAbxW`)LRLh z1?$A2f~sa?Pcj>?gUZE=wwz$>eM@0^IBdZk!Kl{?5>$Y4%X@2^f}Md~2p;nSv*h=9 zReFH<;r3)f=>&=Fu=e!^mlKL08l+)Ri|=N9dIHGe3YH!$2IdOZ3nimJCzJMg z;l+0I2~FDThsdAc&}Qihy!;SIV%E(_52-q81rH>^|R+kf}CHmcXl{y1nno0d>o_ zk?KUIBv1~=fv|l2bvJVu-gEG!jkgDQc;yd2ryc-;bAJLYuuh0|v2zR{ykiQR_`Z*~ zK6Se|uONNpOixi5dPEaEOh? z`xFQDX$blF1LIF6KxTtA0n-(!5Y*y-c-apwA{2$atkcz}=i{1B*JVzSL?^(OeAn@< z#~l>cY12Ilmzm9;CoiTH|g9Il$d}2!aY{@bT>TAjWxN0w%B10UV#}DYPEqaX0G=Z!5T+Y zbT%+ID}6LIu&0{-yB;fclmPyJyhM^b*__ij3Ijo(oMBX<@eorI8X}^mYjYP8DBAYA>f`Hk>B`;GIzKYkF2%H2*05kk=;Z^Z7$kzhYblL{wv3IIr;h-~a!W^meYeD|f zW)*ydW70@clz^(m`?o>2{wAo!@Y@D(;zW_(WY*1izJ)uYCy)me-bu2JlAz|W)77jL z`vx~?Pr5b**7e^M%Xm8yP+X4_q5f3bfa8&p1j0Y}2zDBR0{$Dh8u6wi^Lqv%2&&)3 z&g=QueqD(8o(4${Ad& zf&0eol@A-9S0xym_E0@6e%F=w>F+HS#IxI3S+>@$Mq(@O!yY6)R>DE^H~lLUHLvbI z2R*UQn-NzVz1kmBAFG`^S{2`3i!^`x94t2R&C=Ivd9DUWq1txc*{ykac)^4tXm3*I zn*M_P$+L{_M`kS|if%8l?l9{2rz7`4wF5k`udaV>*4p%@&B46LMnab6+~ISkEG^Lk z3Hu#RUT;P&4XNU*8N9X{Qds7^i>g&UX;-5jmTgqyBYOSDiM^>K1l~L9Q3@|M8BnW zw%So6pXE9(fXbL_Y0yIlnbor!`gz9V+1ZB*#R3HJe6P3^=UwF02oF8ifpw`8TrFdE zJ5}Y_gH`p!MN#!=pV%w3LqTT#1*A1VtI#h#W4u5HYumSdcsfT5n=Q0j6QlOWJ10A% zPb*q&b}O#FpN#EF1G?3VTdN&LFL`>=J@%hhF;)3wLoaFM*&eVS6kXD5EU(yDFB-CZ zRw$>$R_ZB@r5&ZZ%9kdm)MVGcSGm(jcsGT1%wx)i^tfP=$kbM$89;9EO{Sd8tHUAj zrxosMr!}ri_!XK9x)^Q!6}4OHO?4XwZ2z6l{)k`5kLI}v+?r}@Oy~YlK6l%$ubCc< zPu|3C$0wZE805)5@Xq+*^Q?DwIkTaqgoKlc5^G?njc|B*8Fd&jkF4j16Lu@nB){5W zu%CUD4OB<^~ZN1d2wlu*~@-%*I zkPg3c{4WD!x1?7e73k}+X;w^51DcvvKc`w?u|4S;d`cPq*LK-DWE>&>SY_dwo zUQwmzZ%F5~1!{%(n&9<07`&l8BNeY)4A8v!2(P6`iq>YdzB<(T6^~Pjk)nDo_0pl_ z@4Gbb!2QI}C)pV}4!J51?Cy6mq3hS7yi=oL(uWF7dm||nw+HsZZ+SrG2rt}@MEtYG^X3pW4h&3iEy12CCUs53FWNqtdXo7BKG3i5h zRv0hDUZ+OZy8O%&D=crQ(=Kcr8~j-OHFB&iK%-L3)5A9Jl~g55fGCYq0fQOGKXRjk z73x|c^lpXipPi+1^Cd3+x<6&hZaUFYbO4Vz0maG;@usbBB>p^;-!g8h`)%y3ZA4H# zD3p77v+X;Y$S_}rdH-4G;jX? zTxhK8YChzovD{dCBJLo=V35YW7HocLsZ^k^Mwpi&{HUc`5OCQa71Ud&1yp2bv_j8V zU=r8+)v6Qcdh0A@`P4=FS6w(|OJ}Xgd{M*D-1D(8r$Pt z<4nnis1n?+rWz&l!IvLhYyOfvkOT9e{SUwt4L|{c5uvxsk&yX5K;@9I#d9+Xa~bmd zTul>zztgGlKn2&BFEsD|g3WL8y+kyU%WB&qI&wMKE#DJoCB+FlHP7hQ8M(kABv!&j ztSQY^DUaZt(+^ar1C5tlR6Lq}gg?Xg`1rfqbDOT+{aCJ9u~tj&NW`rOai9OrI+v2I z7Bqx|OyuC=e=0tECq5G^MIv|VZ|__wW@%{4H|UttX&RpruJQmE^gURXs?OZfJyD%W zre`0J;%z5$>WER!C#v|$-Zc{1g@v7k2o%X(<-|vJ@vNMVwitm5MIZn+w*Cu)GU|zG*~k zzGt`}OG`U;m%C8q-@spdulY1tnWz|KJ1F?Rj56!&(oJU*BoJm#Z+TXeGT6$F+TO}r z2W}#!@bf(ViWx7Yef4bH?Wq5WxctS-Ux$v#DtH8?{}j04GK6))jOd~EIlOds)&<`= z2ijR)Ycb!2J1H0_>xO-q-p%%px!z@G#DD7^`}G&_FIZm@UImXQ6@4>p#-R;!RXdFG zQ}+_^60oGgj^P$z<$Vy;PJbKLhb@Iy*gPBhlJ)bC&LLr+uKZQss5fOOi&fV=Lm6$T* zRR9?{(A4}Bkz%kXe0gWZY(pDD0twh4R+tT76lY3!{mqKQ7`Ww&EOPhECbqg(rIPPK zvO}bD1B$Gi0l-sD{4N*A*!wX~;uYR+fOO!STMiW~+zcb`D%vlk>aC!O9C;DOG1Aq+ ztYQtaP$|Qd$ovZub8Nwj3_4RRMS^X_)Z0_6?llJDykh!m`wwnnjlzI#wU4z@3CJO; zO7vGaIcQy6SNDKOPD_I!B@~z`L+q9tOcOYVm)+0OLVqTh>S{K$X^auHV^12=J9OzV7C|tkpQtn%BMsw zfZKxw*Yj7cX4%N(o&Y8GTk-Od0(?_+b*b|b}n4Rz$$utbr zvpA;L4bM0b>EDCF7;f|yl9eHbdnLPv!ftM1k^$|FfKa?G72y<~IskURF zLdG0knm;7@TZ4Ive(c0T`{2|-4{7x>K zNjwgRUfd0yfO^xTYj3a zeLbt`ed%jOVBlx)f%5Y&h0?0~>nG2Bo2XxBvb+kRYiT4KiURSII)07z)JwO?vCceg z2!Ywh*gsZCFUuldO^L@KPyy|d@$kLf&D)l&Z_mb(tr73I2k5cm6W%kN)zL(gE|)#E zy-vndA3ljo%Ub?~>qv1%fjbP;j7lPsUe4Ito+x@~f^C70mJRpDBRb*YV?B191tn3uLU zF6z zN{kx?aj?&W?&XQy^wjt05`;*ZoxUY^N4d}mSW%Q=tpkI*-gU;D ze#{PBv)eBZgm7_gvmRa+jfB|-(~|GwP*kJC=aC?K{+@B4fYggl=hVO+wW2}d@1`9r z!AM$xb7ZZ{GWvqUrMF?^-7>o=Q2F@yjJW-6FB(ZV)2%th^NHTm1g-NY)z}jwf$LYF zjGT)!T+Ipsf_Tkx)EjwW!Xg6OzJXMD*I2Ca4@C!gL5i7HG?G3K=Hj?{qDQoBk=rJa zz(sIi85t@j#lGZBu{HleR3Z6;k-W3=gQNv{jPefr{BBzZB#5TWBrL$IXbGIS?~;EL ziqHxae+qQ>tJI_K6ek+>7w&s#DQOt`a9`*X=txb>S3eqBcppx7AkH8KRMOG2^T9t~ z`!Grc6;7PQmC?|J54|71ej3~_^u&pJbEX6uuk8$QOc)qRv+m$))4}U3eHn2RYMU;tyxDMOo*zKX&s{>0>6Q~&@GFD zsYAiMoNp$kGq0i}(1zIRTQ&A5_EV$xpNF4yAgOZPd--gA&PjU|Rs%FW1&_5qqoS{N z^Ao$&r^#ZqAVvz4R>P_hRa?hA$dFS2ndkg>80%^Gk5cqP0C-#iO z5D4yi=HpKkpn|`4cORJ9{&e(bL?K5*|I_j}`J1+4Z6qdb_C;a!B5U0pY07coRz7AVu_~*yuNt?LXs1pmCY=Q z;Doi8Lx*d>fERz}F?EYsE2oL+RX*rnXvMDP`F@SI>;Dw?BNK7I@UGs71N9AsR7`ga zni@c`AX<|7cN3qSf2A5S$birHa%aPzM4kwqF3+w454WRE$d`)kBmUY9Y27gXcPs-kDd72er>Tq+%9oyq{|AG;rP;$Ht)Ly1+`Jx$qa?+@m^n zOI!VLt_z&z*xUWX*p%H^P|6Fjd5;f6tfCoC%O>D^AD}{T8do|^z|e(xFYF1Mt_r=R zM@jUi9AM>}v6HrEPNqY*ubWr}=URRNM zPm^ilaj6buJ4ei;!A!F<|05^K5^dFQjQBq;PCOsvRaIF^3h`_oXiO0 zzwfW=3ndK}-{#)YC8;f(nvo0PX=kIM29e{-ws*TP!0Ib%{rM?Dd8c6LSRe|;P(e&JLbja^Z-{rJ zrP`m0PX;dZ{)3y8wgIS~Gj94%1%+Yf>zcMpvpuLdO3;r6%0E)G(?Z{ycR5wbXL%4H zh>K6ILP>R>Z9=1{pg$6wtt9eg%xkAuS2^V0&=WZzH^ zK0K1&L2rO`hd@#eKx1&;W*~&&eq!o=Q2yfSXlBsE*kIv1E6?hpf5iYW^QC}^8E|VC zNq+EUAH;eqFMu4+oFqN0=qkHL9d^b|sImwQ)l-}>IvToqK;f#CPwnYr0XuF)@NcF~ z!%NIGth-yO#c!UkAQGruxxWFxZ5_vsG<;W~IJ-};9<9(&y!_FL?~zM^!Mq)vWs9!!7oPsd9nx!Q?GL*xEn zK|03fvCGp+X}Q$l;|xd4pJCt@O$I&*z)_!NPw%uABt19;O6Nf*h`5c9TPSfxCN2JY z#o|vqJ^4h5X|V&Sr{Tg?xS_ zfb59iFcs1s)&0Ejm^_LU34hU=ljxjpNCnMLxP@cF@78S!&NNH1NL0TLp%eH13#57s zOdCa}4Bxn_zk{OIb66D0sJO#w0lX1K%MYHs$BdG)oB$Zt-{(#2gyI@L|2 zUh*v~hGp;6m0ABV1?C+WKo|!x0!koxr};Nt;WLsn0{Z8^q1Umr1u4jamQlkauog*{ z&Uo_;pq`FSMxq1!TI6 z1p!=W!UA|!k!V8?79>#9XfsC+-U24*09{qsC1~@gL!@sD1=fV6H={vEgqm zoQU2&gMCuNFhk8Zndo{oDDu$!q7K8%G3Pg+uivRHUXN<19h84=OASLEg)jd-4E>dD ze*FTI0WTdCDPpd;3B?dK!=?+tU#YOCiWEWJ{tcy$MWft;vBRE8x>eRY)BQ!=MiP4n z;aMf1l>h{8CaQ-Af+Eo}^Z@>E3mM|(Cq)wI@vKaMDinc3IRZ^u=7W?z2f8|&&^WYJ z4nX0#eu>e?zj!ZGx>Uban$Nw$OYQ@bKy8(}syoBm)8aXGOW z5p`_L4+vv67;dm

V}1rP;ossluTYI(EPg1~P=jQ6UVqOeg%DA1m`T?=5e$okV? zAHaX~tdC?JlGIvk-)z*UGC#>j^kmh`j40{tB$X2R`DHrR2n zDH-4>mC4~XMIK|Ff^6)!sWy8S!0HR@Ak^;gaO4K$!to3MDwuI!3XE8A{?+g2IJ8H! z^5IlZ9#Dv(&I3$$z{dt?nYo^ng|IS3Ez{F(3yY$) zS?ZI>RYNd4og5Uo$Rb$Z|FE!1Lh~1h2knvNlHE-3e$BO*8vDrrI&7lc&)RYOx$_*U zzcCl`{SQ+%nvj!Kr&v8ect6%t7LXnTg5wiJ7|=XJYoy)C$i$88J%v7^jF-+jpgwN& zT0s)PYY9x~nYovhf>H?r#Un99fxHqGstrICpg-*bzyW07`=OT2l;{d8zyPQTIJ5@Z z+vlveTGkK$Lu)s;Db1P#8=(Z2qZDzc9&`r{9g54yyq*S9?{3wpC%>9&l`teH7~})k zs8k=ipNjvf0(hAxzs956tOWZ7`ls?Zwo_wNEgBJzV)VV_aZDCO6f(YE7P>`4$z}x_t71HV4qB#&B%!S# z_rO`b1yYoWcUB4y5s{?P0yx*@xCsO9A3VPIq1F@|k8Ww`#;1UMA)X7+fiDEg?3O~O zGxxLb%<)yNMB8LY=hFa6pZ-Z+f7Sr{Ytgn+T2Ga4aDDl-T%it3pm}HxPV0pkV-B|2 zdd#)@E0YkRresG>7fz}PqN$LN{$NE#fs2{&*{a=<6DETWPlp?!!z%7(e%!&aBkd?) zt=Za3hc)jfcHT`mq4HP>PIz+IbQDOfG#PX#PN2p-y_e`SFAue9qe{}?75-E_4C+!9 z>A=oCGyBvChmTfNY_BjAo?E@3JU#p^gHG@o)I#3^e7Ha>Go#K#_j2>?umG|2k&%Gs zB5{5qB0c&shUh7Z&L*o-7IynDfSY_lVZeCoc5NKAXr_q<0FVd%#|2p5#M?0Mek%p# zdp2))DohnQPKl+pzMLISaC8o-yN?v;AlN|L5SL6zL#Zor+T|ba0n>rK`OA^X!q$h0FqtD1c=~aVld?+eb5FRMClz@x_2!Zkh47d zP5L?x?O8@;PH63%y4gSNTaAY;b*id5U#2f;jnfffy@iVyS^#^Jv;6f^T3B$o)pf@# zg+9<(6>{(c*j>j=^z=eaJpU2gVXaZqh;q%qRQUxAQ$rq7&sBhY@(3BcfGg*EP_DK* zK_z&}(&PueY&xme7aOo7)7yN9_B^hG>*QnAR8c5e>{g589k0ckK=gz>JgX5z9%S{$ z3D4&j;iPrOTEWhDAhY+iKmTwA0)R4lyy7b5F3~6lo*a*^cSt~B<<%p3`)n7=@4uTC zeZOMD2`F@V(n<`%$8oME8f{>mj%j%L@@8YxXyxVL{3w*(@u*3UDv|`AAM3`34lA!S zq;rjIo-Tpsx0!s5c26;*7c350?um*f68|yN;T`wDxkJQe72k0cf;Plg@0Wh7_76`F zaBB_^@JA-BAM*h?&A!=yX_id%NI3x*h2VLEn}Po76Tf42Gi5*xg?A6|zo2aTp)@9f z6CjBTNdk@+vw#c-vgb5f$MS$H-jIP6($GF;ODlxOni@2X>5x6IZ2 z;f*LXNzOwFD9MBhInPQ32QSlM42aCD57+r(CJruQVt^#)g83E;JXQZMg_G=TruA*kI)5pbDDkOaq)bHPP4?#?!Z zVgP;fGZ$cI$8KiwPA(ZU51ujAw%no#cK3OH!~3TKi@+~c{Xb~^gxV!0x44fZ@O7J3 zs(N#;w_WN)y3sDVTbL=fJjyCm-|*PV=fz1HcUeZ87bIY1@}MKEW822HEGsYhf-v!e zI`9nJ1~IeppVns-uBU$E7C@PTdwa==x&yQPX!Jgjfh!}p=dg0(3`ukWqBK!E?Y3y$ z?{hyMY*g-!GzV%+*O2LApbroJduG)6mlTi&Nr4M>+@&L=ZrC7l%;XhmEvT%8bh~8i zxMHC`TX2ZsPPo*0XjwqkIdN z!!IPCtUf<4A9~0&cyT8F;Aa=o_W4-udeHx6&D#K~B6CsbDN=HyWxa~QH*kzv!d8}< zPpRv%4xY})A9@>4bhEhNOWhk>tR4Z*H7XBC;;{ia9fr1g&z zL&0FNDMvw<{^ngn-jOQp-+CpH6l$1!6Aut6EcviG&O`{BVDH{bu&!(JZ#QCh&GHw@1)%BeD`yu0rLB^(assATIx+WHd#v!9+qrNmFsHtmhE_idG>m?I= zadg4od0;5Px^s?>k($FA$HfgOHVRj zJAweDvdIJSZ?+Npp+w)_*rjkt_i05?^O@MvAi6RT7!59&za-T7s`DHZo7g;W!D%Rm zM_S5UQ!fGdF%H~mvs_?igFaHx7%r!(z%m^B_x?EUwdWU5d+t=dW3ricZDMW0f#BYw zBk5JV%@M70apP|4H9FU9SSLffXselK+(&g#Si2G&ysLx8t6j1gZG4bZ1ftkWUey&gdowzjE1(;eSBm-FunI^Cz@ZqxWDMNL!ez0N}4Rs56>2qsw6Hh9` z#B9Fms12AAHV|P7-v8R4)X6Hsq&Rft+E&LYQWRO%wcZXyDx)mv9+U)H3FpiAhF^9B z8kK>^&bX}ReRp)e!}M8EXM)Xf?xZ|9JQx|uur zkanl_#rmQPct+q{1(O#cUtM|RdSd04F9phqSYGraHp#u(GX|gLzTG!j)QUOz+-eAL z%6~^?k>7NN8O;f|nL1Q^wvmc;+p-sy>ZIXgt6{ivbpO*E`tscX@Sa_Y#Eh%Q3043Y z2`5%ek2Bg*H!S~HV##_bQqo$;{=H9!r3if>uzN8C2Nk7gm3p+q)??_C8rGyoax{?M z-id9PoA+7K_9yFLXe~r;_rzm)rX5G?{3PfNTH{#MPp2nZ~L?|`9R3ghfkj;+TQ-@m<1fPaxC1j(kbC7Rra-4{b%>d9Lcx}e zc}W5`gMwL$_$XU2vCy^3Dl*wCo%q@hanpc9@}isW2A?wu>m12mm{T#L3L29-mNtEA zO+iKzUZZrXgkDhB%y**R*gc2uH0IBhkulm6=F}iJ+63P{d&?sfT@p^1AlQE^Sz|Yp)PthQnCWOQ^@vl+doq z)eAOj+{r9OvP)fGtCI#|p)Wyis8jziRp3Yd%OlCHOh%lWZSJMyP5D1H*Qvw#)1Mb^ zNR%Ck$8%bfD=E|@IKrCFN2%m05t>>H9J=7{!R0~vw||Ls0jrFI_R$SkN%QAqz=d)) zdF3XTSCDEz2}UicB$@|` zqHbDRmx0OlclrdnOyAT#Ph+4%ziK(dfA3+HWmJgEH&5=QImW<8D{W3Z+Ev2;XS2C% z&^8aI<7>AZpG@}1&koqR(c-${1D38Cqu5~XDOA^ocm5=Kp!L)OBCigU4U%?fdl zc@>kA?IOaBo4->#dY$UqF9kxCavU9)Ds8x0$STd^93}SC>6TWDS}-!^YYxVg&%Oh* zb`Hir&JC>|+P_2rE0r7_2wFGOp3o><5!E-m{HcpdA&mi1<79X6Hc-*f*%ysES z8$j=?dJ%DG387!f`Q9;#-b5gGy24xfNlGh^cuGy=J^^CIs2iQvQ9zon;mr5!#+RCW zz;N@^D%a6X$V$-v=V1+QBrZzZMuVdBg*efk8<{%R0%!zos#0W6Cyy^r^bFg&3{KIa zyL7^@tH+R+t;e?DQDn5(qg#A{Hnnbqa=r<3i^)wRU#)3*JwjoO>+4q@jf&3`2{Dsd)yNVohbSHhJT zWEP0aLEzH?w^WL(t$3tMhxuJS=Hiyiy-~_H zqXS5$(*}Vt`6Y%D@}>E(i;W2O@G53y5Q!Hzf`b8(>TM{(d^kKh{qUJ^~!}1in zi^?U#lwp*>66sZX0?`j7&UB^Ef}4FT8lL-xaQ(DziDfW*;gHJFAZ#9;EFJRNFj*#f zCH+*L0FC|5s!jn0Yp6FsleYZxi(w)!9W5>Xgp>}5t@ zf7z)z^B4sex@njp3(!9uM`hl?JQ@psD7mrb29*;NNU2JPI6lm(^blqmK8tICGx|7_ zpzqgX5_zA`?+IenQzDp+BI)P#@h{Fo|I#Gv<`$PzU7L?7{zoZ=HywS30}CHc$lD16 zlu0FCo9N}KKw^$5<*jm2W^ z6kVueSoxO@ppIS}B!XE>Qinl?vqMfm9K$gH9Jn9Hu{wQ>O2D$s8y00_HUg@DQ-{>~ zApC&Lb?@tDLQw?l1<{ELPDwVtLFC&4hWpF?*6$i;q=2g7d-QjcVkOv7y z)qFW8f3w<2=S;T_vG6MXu=u*^YZ9n-`9s3Gg}+=Xy-d_p8xpGRD5m=rZR;>lfv(~d zNI%KaHM|!8=Nq8Runhd^@>97}j#KOe7YbEZ7zskV>(1#p?$MIb)7-h%nJr}V$EK_B zD8q{Tv-B3-4{Z>#Lq|d!qp$^t>udr|`Cda_OtIWlXhHXN0NT9TAXOjta0GDUQ?~^M ziib`w3SWL&>G2FL4GZ~58Zh&Fa~qyq^S)6Aa+00Jo6Wn-l+BU;lJ0-}d=sSThRp_{ zc@j8qLQd(9=Vh`3PCkM^Y!;d$X;A_*@5b$UPcJ5}ZXJua36L4X?py+oKBmanX8QWi z)W+A(-N@RRwTd{U!a@@Ij#5)bTazIMDA$F=f8?wc61&rC@yFLv?Urbl4obB zxwARnb8?Z}>(jAV!T7Fe$xaAph)qa+8vYzs*7zr@qC+oHJApGCeGoehE0BeYuzrMG zN3vh;v{U)!hf^1#euDi&E?ZW-cvcf$uGfhviUrflv_Y{U1N;K>LmQywr$-N6Z!kgP zZS3}N%6xHRs|>Df#k9f||0`!gh$<71cglb>Fp>mmxQN!7$d?Xw>E#cy{$xE5=A{8! zq0%sNZlj#R?00)?8`VATJ->oATtwi}9ZTpw54b%h-C$D{HYP1V*fN`6jviPaj1$_7 zbxN8FQFwAeaY&ARd&a@wH6K5IbGH8qM{Enn&!f!>B^eyn?Sm*laX*gqRS>X6?eI06 z(QQ{Nle}+jvzuQay{NK}jh|XK#${MHp;V!+p_|}8iG(I9nnXo6qIDY0R`y6s^XfWP zIz>~PjyvfU#ed@@aJF>P>`Xmy-!m1m9Y`NhyBgikGHJffXb34?`|UAET5OG!hIH@v z8fWx4YaLUC?J4i&^j~lHn~d8HpiI1gh{8{qpKnBT^1FL1HyhH`LET-E5##%pvOOU^ z&&``*0(^p~p{7)srw+FSb>XA{b%C9rWNi13NvMC*x*;)W8!zV+A#?ea-_s@w}kg?8v&ZeOD6JAeh4 zB3D@BFAK`Ciq%If*mG7bYomW3qmeY znM^0Lx5ZHjw6H0<*J5XY%CMK*r=DhkBZ=Sf5cE`>`B)Uf05VopVlUlJj__`9&iEBp zC0NB9woV-PWiZzycl)Q!;upvagBD=s?}OPjZVE^lfRuLY!-hKoc5sScWueN%A~j>G zLiZ@xqxTkEa=xpJbj$`;#W^WTyjCnco`qzg|M~Elh++h-Q*o%}o!98zu-MF+SoHHK zPxJ=Rwn%~=HkN=)oXh% literal 0 HcmV?d00001 diff --git a/rails-to-caveman.asd b/rails-to-caveman.asd index 3b0fde3..848f7aa 100644 --- a/rails-to-caveman.asd +++ b/rails-to-caveman.asd @@ -12,6 +12,9 @@ #:local-time ; <-- Added Chapter 6 #:ratify ; <-- Chapter 7 #:trivia ; <-- Chapter 10 + #:plump ; <-- Chapter 12.5 + #:dexador ;<-- Chapter 12.5 + #:clss ;; for @route annotation #:cl-syntax-annot @@ -32,11 +35,14 @@ :components ((:module "src" :components ((:file "main" :depends-on ("config" "view" "db")) - (:file "web" :depends-on ("view" "model")) + (:file "web" :depends-on ("view" "model" "rfc2616-sec10")) (:file "view" :depends-on ("locale" "config")) (:file "db" :depends-on ("config")) - (:file "model" :depends-on ("db")) + (:file "model" :depends-on ("db" "storage")) (:file "locale" :depends-on ("config")) ; <--- This! + (:file "storage") ; Chapter 13 + (:file "rfc2616-sec10") ; Chapter 12.5 (status-code) + ;; (:file "helpers" :depends-on ("rfc2616-sec10")) ; Chapter 12.5 (:file "config")))) :description "Rails to Caveman2 port." :in-order-to ((test-op (test-op "rails-to-caveman-test")))) diff --git a/src/ch12.5.lisp b/src/ch12.5.lisp new file mode 100644 index 0000000..759226f --- /dev/null +++ b/src/ch12.5.lisp @@ -0,0 +1,132 @@ +#| Contains the code in Chapter 12.5. +====================================================================== +At the time of writing, I do not know where/if the code in this +chapter is supposed to go into the main source code files of the +project. Until then, I have put the code here as a future reference +and as a place to store it until I have worked it out. +|# + +(defvar *doc* (plump:parse + (dexador:get "https://www.w3.org/protocols/rfc2616/rfc2616-sec10.html"))) + +(defun constant-forms() + (mapcon (lambda(list) + (when (equal "h3" (plump:tag-name (car list))) + (let*((position (position "h3" + (cdr list) + :test #'equal + :key #'plump:tag-name)) + (ps (subseq (cdr list) 0 position)) + (h3 (loop :for element + :across (plump:children (car list)) + :when (plump:text-node-p element) + :collect (plump:text element) + :into result + :finally (return + (string-trim " " + (apply #'concatenate 'string result))))) + (code)) + (multiple-value-bind (match-p start) + (ppcre:scan "^[0-9][0-9][0-9]" h3) + (if (and match-p (not (eql 306 + (setf code (parse-integer h3 + :junk-allowed t))))) + `((defconstant ,(read-from-string (format nil "+~A+" + (substitute #\- #\space(string-trim + " " + (ppcre::nsubseq h3 start))))) + ,code ,(string-trim '(#\newline #\space) + (remove #\return + (apply #'concatenate 'string + (mapcar #'plump:text ps))))))))))) + (let* ((vector (plump:child-elements (aref (clss:select "body" *doc*)0))) + (position (position "h3" vector :test #'equal + :key #'plump:tag-name))) + (coerce (subseq vector position)'list)))) + +#| Run the following in the REPL +(constant-forms) ; <------ enter this + +It should give you an output similar to this... + +((DEFCONSTANT +CONTINUE+ 100 + "The client SHOULD continue with its request. This interim response + is used to inform the client that the initial part of the request + has been received and has not yet been rejected by the server. The + client SHOULD continue by sending the remainder of the request or, + if the request has already been completed, ignore this + response. The server MUST send a final response after the request + has been completed. See section 8.2.3 for detailed discussion of + the use and handling of this status code.")) +|# + +(defun thunk() (let ((list (constant-forms))) + (format t "~&~(~S~)" + `(in-package :cl-user)) + (format t "~&~(~S~)" + `(defpackage #:rfc2616-sec10 (:use :cl) + (:nicknames #:status-code) + (:export ,@(mapcar #'cadr list)))) + (format t "~&~(~S~)" `(in-package #:rfc2616-sec10)) + (format t "~{~&~%~S~}" list))) + +(defmacro with-authenticity-check ((&rest check*) &body body) + (labels ((rec (list) + (if(endp list) + `(progn ,@body) + (body (caar list) + (cadar list) + (cdr list)))) + (body (key value rest) + (ecase key (:token + `(if (not (string= ,value (token))) + (throw-code status-code:+forbidden+) + ,(rec rest))) + (:logged-in `(if (not(hermetic:logged-in-p)) + (throw-code status-code:+unauthorized+) + ,(rec rest)))))) + (rec (mapcar #'alexandria:ensure-list check*)))) + +(defmacro ensure-let ((&rest bind*) &body body) + (labels ((rec(binds) + (if (endp binds) + `(progn ,@body) + (body (car binds)(cdr binds)))) + (body (bind rest) + `(let (,bind) + (if (null ,(car bind)) + (myway:next-route) ,(rec rest))))) (rec bind*))) + +(defgeneric update-instance (object &rest args)) + +(defmethod update-instance ((object standard-object )&rest args) + (loop :with initargs = (loop :for key :in args :by #'cddr :collect key) + :for slot :in (c2mop:class-slots (class-of object)) + :for keys = (intersection (c2mop:slot-definition-initargs slot) initargs) + :when (and keys (or (null (cdr keys)) (error "Dupcated initargs ~S"keys))) + :do (let ((value (getf args(car keys)))) + (unless (equal "" value) + (setf (slot-value object + (c2mop:slot-definition-name slot)) + value)))) + object) + +(define-method-combination validate() + ((primary (validate) :required t)) + (labels((rec(methods) + (if (endp (cdr methods)) + `(call-method ,(car methods) nil) + `(multiple-value-bind(o e),(rec (cdr methods)) + (values o (append e (nth-value 1 (call-method ,(car methods) nil)))))))) + (rec primary))) + +(defgeneric validate(object &key target-slots test) + (:method-combination validate)) + +(defmacro method-case (method &rest clauses) + (let ((var (gensym"VAR"))) + `(let ((,var ,method)) + (cond ,@(mapcar (lambda(clause) + `((string= ,(car clause),var),@(cdr clause))) + clauses) + (t (throw-code status-code:+method-not-allowed+)))))) diff --git a/src/helpers.lisp b/src/helpers.lisp new file mode 100644 index 0000000..fea97b9 --- /dev/null +++ b/src/helpers.lisp @@ -0,0 +1,119 @@ +(defpackage #:rails-to-caveman.helpers + (:use #:cl + #:plump + ;; #:dexador + #:clss + #:status-code) + (:shadowing-import-from #:dexador + #:get) + (:export #:*doc*)) +(in-package #:rails-to-caveman.helpers) + +(defvar *doc* (plump:parse + (dexador:get "https://www.w3.org/protocols/rfc2616/rfc2616-sec10.html"))) + +(defun constant-forms() + (mapcon (lambda(list) + (when (equal "h3" (plump:tag-name (car list))) + (let*((position (position "h3" + (cdr list) + :test #'equal + :key #'plump:tag-name)) + (ps (subseq (cdr list) 0 position)) + (h3 (loop :for element + :across (plump:children (car list)) + :when (plump:text-node-p element) + :collect (plump:text element) + :into result + :finally (return + (string-trim " " + (apply #'concatenate 'string result))))) + (code)) + (multiple-value-bind (match-p start) + (ppcre:scan "^[0-9][0-9][0-9]" h3) + (if (and match-p (not (eql 306 + (setf code (parse-integer h3 + :junk-allowed t))))) + `((defconstant ,(read-from-string (format nil "+~A+" + (substitute #\- #\space(string-trim + " " + (ppcre::nsubseq h3 start))))) + ,code ,(string-trim '(#\newline #\space) + (remove #\return + (apply #'concatenate 'string + (mapcar #'plump:text ps))))))))))) + (let* ((vector (plump:child-elements (aref (clss:select "body" *doc*)0))) + (position (position "h3" vector :test #'equal + :key #'plump:tag-name))) + (coerce (subseq vector position)'list)))) + +(defun thunk() (let ((list (constant-forms))) + (format t "~&~(~S~)" + `(in-package :cl-user)) + (format t "~&~(~S~)" + `(defpackage #:rfc2616-sec10 (:use :cl) + (:nicknames #:status-code) + (:export ,@(mapcar #'cadr list)))) + (format t "~&~(~S~)" `(in-package #:rfc2616-sec10)) + (format t "~{~&~%~S~}" list))) + +(defmacro with-authenticity-check ((&rest check*) &body body) + (labels ((rec (list) + (if(endp list) + `(progn ,@body) + (body (caar list) + (cadar list) + (cdr list)))) + (body (key value rest) + (ecase key (:token + `(if (not (string= ,value (token))) + (throw-code status-code:+forbidden+) + ,(rec rest))) + (:logged-in `(if (not(hermetic:logged-in-p)) + (throw-code status-code:+unauthorized+) + ,(rec rest)))))) + (rec (mapcar #'alexandria:ensure-list check*)))) + +(defmacro ensure-let ((&rest bind*) &body body) + (labels ((rec(binds) + (if (endp binds) + `(progn ,@body) + (body (car binds)(cdr binds)))) + (body (bind rest) + `(let (,bind) + (if (null ,(car bind)) + (myway:next-route) ,(rec rest))))) (rec bind*))) + +(defgeneric update-instance (object &rest args)) + +(defmethod update-instance ((object standard-object )&rest args) + (loop :with initargs = (loop :for key :in args :by #'cddr :collect key) + :for slot :in (c2mop:class-slots (class-of object)) + :for keys = (intersection (c2mop:slot-definition-initargs slot) initargs) + :when (and keys (or (null (cdr keys)) (error "Dupcated initargs ~S"keys))) + :do (let ((value (getf args(car keys)))) + (unless (equal "" value) + (setf (slot-value object + (c2mop:slot-definition-name slot)) + value)))) + object) + +(define-method-combination validate() + ((primary (validate) :required t)) + (labels((rec(methods) + (if (endp (cdr methods)) + `(call-method ,(car methods) nil) + `(multiple-value-bind(o e),(rec (cdr methods)) + (values o (append e (nth-value 1 (call-method ,(car methods) nil)))))))) + (rec primary))) + +(defgeneric validate(object &key target-slots test) + (:method-combination validate)) + +(defmacro method-case (method &rest clauses) + (let ((var (gensym"VAR"))) + `(let ((,var ,method)) + (cond ,@(mapcar (lambda(clause) + `((string= ,(car clause),var),@(cdr clause))) + clauses) + (t (throw-code status-code:+method-not-allowed+)))))) diff --git a/src/model.lisp b/src/model.lisp index 340de0d..2d2482e 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -46,9 +46,28 @@ (defun user-article-and-entry-table-check () (with-connection (db) (mito:ensure-table-exists '(user article entry)))) - -(defclass user () +(defclass file() + ((filename :col-type (or :null (:varchar 128)) + :initarg :filename + :accessor filename-of) + (content-type :col-type (or :null (:varchar 32)) + :initarg :content-type + :accessor content-type-of)) + #| USE OF MITO:DAO-TABLE-MIXIN (Chapter 13) + =================================================================== + Use 'table-mixin' to pull together data (I.E. database fields) from + different tables. Database tables can be inherited in mito so you do + no need a table for every structure you want to create/map between the + source code and the database layer. + |# + (:metaclass mito:dao-table-mixin)) + +(defclass image (file)() + ;; See note about dao-table-mixin above in 'file' class. + (:metaclass mito:dao-table-mixin)) + +(defclass user (image) ; 'image' class defined below (chapter 13). ((number :col-type :integer :initarg :number :accessor number-of) @@ -80,67 +99,6 @@ (:metaclass mito:dao-table-class)) -(defun seeds() - ;; '#(' are ARRAY LITERALS. I keep forgetting this and need to look - ;; it up. - (let ((names - #("Taro" "Jiro" "Hana" "John" "Mike" "Sophy" "Bill" "Alex" "Mary" "Tom")) - (fnames ; First Names - #("Hippo" "Darling" "Lopez" "Jerry")) - (gnames ; Given Names - #("Orange" "Fox" "Snake"))) - (with-connection (db) - (dotimes (x 10) - (mito:create-dao 'user - :number (+ x 10) - :name (aref names x) - :full-name (format nil "~A ~A" - (aref fnames (rem x 4)) - (aref gnames (rem x 3))) - :email (format nil "~A@example.com" (aref names x)) - :birthday "1981-12-01" - :sex (nth (rem x 3) '(1 1 2)) - ;; Removed 'p' from end of :administrator -- - ;; so the code differs from the code in the - ;; tutorial (Chapter 4). I had to change it - ;; because it produced errors when trying to - ;; seed the database (using 'seeds' - ;; function. I have, also, left a note in the - ;; 'user' class definition highlighting this. - :administrator (zerop 0) - :password "asagao!")) - ;; "#.(" is an ARRAY LITERAL. (Noted in 'Loving Common Lisp' book). - (let ((body #.(with-output-to-string (*standard-output*) - (format t "Morning glory wins.~2%") - (write-line "hgoe hoge boge hoge") - (write-line "fuga fuga guffaug uga") - (write-line "tasdf asdf asdf sadf"))) - (now-time (local-time:now))) - (dotimes (x 10) - (mito:create-dao 'article - :title (format nil "Result:~D" x) - :body body - :date-released (local-time:timestamp- now-time (- 8 x) :day) - :date-expired (local-time:timestamp- now-time (- 2 x) :day) - :member-only (zerop 0))) - (dolist (name '("Jiro" "Taro" "Hana")) - (let ((user (mito:find-dao 'user :name name))) - (when user (dotimes (x 10) - (mito:create-dao 'entry - :user user - :title (format nil "Title~D" x) - :body body - :date-posted (local-time:timestamp- now-time (- 10 x) :day) - :status (nth (rem x 3) '("draft" "member-only" "public"))))))))))) - - -(defun rebuild () - "Drops the current database table, recreates it and populates it using seeded data." - (with-connection (db) - (mapc #'mito:ensure-table-exists '(user article entry)) - (mapc #'mito:recreate-table '(user article entry))) - (seeds)) - (defun ids () "Produces a list of all the Id's in the database. Part of Chapter 4 tutorial and is a port of the 'ids method' in the Ruby on Rails book @@ -488,6 +446,18 @@ reference for future projects. This is a learning project after all. posted-hour posted-min))) ,@args))) +(defclass entry-image (image) + ((entry + :col-type entry + :initarg :entry + :accerror entry-of) + (alt-text + :col-type (:varchar 128) + :initform "alt-text" + :initarg :alt-text + :accerror alt-text-of)) + (:metaclass mito:dao-table-class)) + (defmethod mito:delete-dao :before((user user)) (mito:delete-by-values 'entry :user-id (mito:object-id user))) @@ -502,3 +472,135 @@ reference for future projects. This is a learning project after all. (:key #'local-time:parse-timestring)) (status (:require t) (:assert (find status '("draft" "member-only" "public"):test #'equal)))))) + +;;; Added in Chapter 13 +;; (defmethod validation:validate validation:validate ((image image) &key target-slots test) +;; (validation:with-check-validate (image +;; :target-slots target-slots +;; :test test) ((content-type +;; (:assert (find content-type #0='("image/jpeg" "image/png" "image/gif" "image/bmp") +;; :test #'equal) +;; "must be one of ~S but ~S" #0# content-type))))) + + +;; ;;; Reimplemented in Chapter 13. +;; (defmethod validation:validate validation:validate ((object entry-image) +;; &key target-slots test) +;; (validation:with-check-validate (object +;; :target-slots target-slots +;; :test test) +;; ((entry (:require t)) (filename (:require t))))) + +(defmethod validation-validate validation-validate ((image image) &key target-slots test) + (with-check-validate (image) + ;; :target-slots target-slots + ;; :test test) + ((content-type + (:assert (find content-type #0='("image/jpeg" "image/png" "image/gif" "image/bmp") + :test #'equal) + "must be one of ~S but ~S" #0# content-type))))) + + +;;; Reimplemented in Chapter 13. +(defmethod validation-validate validation-validate ((object entry-image) + &key target-slots test) + (break) + (with-check-validate (object) + ;; :target-slots target-slots + ;; :test test) + ((entry (:require t)) (filename (:require t))))) + +(defun seeds() + ;; '#(' are ARRAY LITERALS. I keep forgetting this and need to look + ;; it up. + (let ((names + #("Taro" "Jiro" "Hana" "John" "Mike" "Sophy" "Bill" "Alex" "Mary" "Tom")) + (fnames ; First Names + #("Hippo" "Darling" "Lopez" "Jerry")) + (gnames ; Given Names + #("Orange" "Fox" "Snake"))) + (with-connection (db) + (dotimes (x 10) + (mito:create-dao 'user + :number (+ x 10) + :name (aref names x) + :full-name (format nil "~A ~A" + (aref fnames (rem x 4)) + (aref gnames (rem x 3))) + :email (format nil "~A@example.com" (aref names x)) + :birthday "1981-12-01" + :sex (nth (rem x 3) '(1 1 2)) + ;; Removed 'p' from end of :administrator -- + ;; so the code differs from the code in the + ;; tutorial (Chapter 4). I had to change it + ;; because it produced errors when trying to + ;; seed the database (using 'seeds' + ;; function. I have, also, left a note in the + ;; 'user' class definition highlighting this. + :administrator (zerop 0) + :password "asagao!" + :filename (when (zerop x) "profile.png") + :content-type (when (zerop x) "image/png"))) + ;; "#.(" is an ARRAY LITERAL. (Noted in 'Loving Common Lisp' book). + (let ((body #.(with-output-to-string (*standard-output*) + (format t "Morning glory wins.~2%") + (write-line "hgoe hoge boge hoge") + (write-line "fuga fuga guffaug uga") + (write-line "tasdf asdf asdf sadf"))) + (now-time (local-time:now))) + (dotimes (x 10) + (mito:create-dao 'article + :title (format nil "Result:~D" x) + :body body + :date-released (local-time:timestamp- now-time (- 8 x) :day) + :date-expired (local-time:timestamp- now-time (- 2 x) :day) + :member-only (zerop 0))) + (dolist (name '("Jiro" "Taro" "Hana")) + (let ((user (mito:find-dao 'user :name name))) + (when user (dotimes (x 10) + (mito:create-dao 'entry + :user user + :title (format nil "Title~D" x) + :body body + :date-posted (local-time:timestamp- now-time (- 10 x) :day) + :status (nth (rem x 3) '("draft" "member-only" "public"))))))) + ;; PROBLEM IS IN HERE.... + (with-open-file (s (merge-pathnames #P"profile.png" + rails-to-caveman.config::*application-root*) + :element-type '(unsigned-byte 8)) + (let ((vector (make-array + (file-length s) + :element-type '(unsigned-byte 8)))) + (read-sequence vector s) + (storage::write + (make-instance 'flex::vector-input-stream :vector vector) 1 "account" + (storage::make-file :name "profile.png" :content-type "image/png")) + ;; PROBLEM IS IN HERE.... + )))))) + +#| +(defun seeds() (with-open-file (s (merge-pathnames "profile.png" + your-app.config::*application-root*) + :element-type '(unsigned-byte 8)) + (let ((vector (make-array (file-length s) + :element-type '(unsigned-byte 8)))) + (read-sequence vector s) + (storage::write (make-instance 'flex::vector-input-stream + :vector vector) 1 "account" + (storage::make-file :name "profile.png" + :content-type "image/png")))) + (let ((names #("Taro" "Jiro" "Hana" "John" "Mike" "Sophy" "Bill" "Alex" "Mary" "Tom")) ...) + (with-connection (db) + (dotimes (x 10) + (mito:create-dao 'user :number (+ x 10) ... + :password "asagao!" + :filename (when(zerop x) "profile.png") + :content-type (when(zerop x) "image/png") )) ...))) +|# + +(defun rebuild () + "Drops the current database table, recreates it and populates it using seeded data." + (with-connection (db) + (mapc #'mito:ensure-table-exists '(user article entry)) + (mapc #'mito:recreate-table '(user article entry))) + (seeds)) diff --git a/src/rfc2616-sec10.lisp b/src/rfc2616-sec10.lisp new file mode 100644 index 0000000..f90d2c6 --- /dev/null +++ b/src/rfc2616-sec10.lisp @@ -0,0 +1,604 @@ +;; (in-package :cl-user) +(defpackage #:status-code + (:use :cl) + (:nicknames #:rfc2616-sec10) + (:export +continue+ + +switching-protocols+ + +ok+ + +created+ + +accepted+ + +non-authoritative-information+ + +no-content+ + +reset-content+ + +partial-content+ + +multiple-choices+ + +moved-permanently+ + +found+ + +see-other+ + +not-modified+ + +use-proxy+ + +temporary-redirect+ + +bad-request+ + +unauthorized+ + +payment-required+ + +forbidden+ + +not-found+ + +method-not-allowed+ + +not-acceptable+ + +proxy-authentication-required+ + +request-timeout+ + +conflict+ + +gone+ + +length-required+ + +precondition-failed+ + +request-entity-too-large+ + +request-uri-too-long+ + +unsupported-media-type+ + +requested-range-not-satisfiable+ + +expectation-failed+ + +internal-server-error+ + +not-implemented+ + +bad-gateway+ + +service-unavailable+ + +gateway-timeout+ + +http-version-not-supported+)) +(in-package #:status-code) + +;;rfc2616-sec10) + +(DEFCONSTANT +CONTINUE+ + 100 + "The client SHOULD continue with its request. This interim response is + used to inform the client that the initial part of the request has + been received and has not yet been rejected by the server. The client + SHOULD continue by sending the remainder of the request or, if the + request has already been completed, ignore this response. The server + MUST send a final response after the request has been completed. See + section 8.2.3 for detailed discussion of the use and handling of this + status code.") + +(DEFCONSTANT +SWITCHING-PROTOCOLS+ + 101 + "The server understands and is willing to comply with the client's + request, via the Upgrade message header field (section 14.42), for a + change in the application protocol being used on this connection. The + server will switch protocols to those defined by the response's + Upgrade header field immediately after the empty line which + terminates the 101 response. + + The protocol SHOULD be switched only when it is advantageous to do + so. For example, switching to a newer version of HTTP is advantageous + over older versions, and switching to a real-time, synchronous + protocol might be advantageous when delivering resources that use + such features.") + +(DEFCONSTANT +OK+ + 200 + "The request has succeeded. The information returned with the response + is dependent on the method used in the request, for example: + + GET an entity corresponding to the requested resource is sent in + the response; + + HEAD the entity-header fields corresponding to the requested + resource are sent in the response without any message-body; + + POST an entity describing or containing the result of the action; + + TRACE an entity containing the request message as received by the + end server.") + +(DEFCONSTANT +CREATED+ + 201 + "The request has been fulfilled and resulted in a new resource being + created. The newly created resource can be referenced by the URI(s) + returned in the entity of the response, with the most specific URI + for the resource given by a Location header field. The response + SHOULD include an entity containing a list of resource + characteristics and location(s) from which the user or user agent can + choose the one most appropriate. The entity format is specified by + the media type given in the Content-Type header field. The origin + server MUST create the resource before returning the 201 status code. + If the action cannot be carried out immediately, the server SHOULD + respond with 202 (Accepted) response instead. + + A 201 response MAY contain an ETag response header field indicating + the current value of the entity tag for the requested variant just + created, see section 14.19.") + +(DEFCONSTANT +ACCEPTED+ + 202 + "The request has been accepted for processing, but the processing has + not been completed. The request might or might not eventually be + acted upon, as it might be disallowed when processing actually takes + place. There is no facility for re-sending a status code from an + asynchronous operation such as this. + + The 202 response is intentionally non-committal. Its purpose is to + allow a server to accept a request for some other process (perhaps a + batch-oriented process that is only run once per day) without + requiring that the user agent's connection to the server persist + until the process is completed. The entity returned with this + response SHOULD include an indication of the request's current status + and either a pointer to a status monitor or some estimate of when the + user can expect the request to be fulfilled.") + +(DEFCONSTANT +NON-AUTHORITATIVE-INFORMATION+ + 203 + "The returned metainformation in the entity-header is not the + definitive set as available from the origin server, but is gathered + from a local or a third-party copy. The set presented MAY be a subset + or superset of the original version. For example, including local + annotation information about the resource might result in a superset + of the metainformation known by the origin server. Use of this + response code is not required and is only appropriate when the + response would otherwise be 200 (OK).") + +(DEFCONSTANT +NO-CONTENT+ + 204 + "The server has fulfilled the request but does not need to return an + entity-body, and might want to return updated metainformation. The + response MAY include new or updated metainformation in the form of + entity-headers, which if present SHOULD be associated with the + requested variant. + + If the client is a user agent, it SHOULD NOT change its document view + from that which caused the request to be sent. This response is + primarily intended to allow input for actions to take place without + causing a change to the user agent's active document view, although + any new or updated metainformation SHOULD be applied to the document + currently in the user agent's active view. + + The 204 response MUST NOT include a message-body, and thus is always + terminated by the first empty line after the header fields.") + +(DEFCONSTANT +RESET-CONTENT+ + 205 + "The server has fulfilled the request and the user agent SHOULD reset + the document view which caused the request to be sent. This response + is primarily intended to allow input for actions to take place via + user input, followed by a clearing of the form in which the input is + given so that the user can easily initiate another input action. The + response MUST NOT include an entity.") + +(DEFCONSTANT +PARTIAL-CONTENT+ + 206 + "The server has fulfilled the partial GET request for the resource. + The request MUST have included a Range header field (section 14.35) + indicating the desired range, and MAY have included an If-Range + header field (section 14.27) to make the request conditional. + + The response MUST include the following header fields: + - Either a Content-Range header field (section 14.16) indicating + the range included with this response, or a multipart/byteranges + Content-Type including Content-Range fields for each part. If a + Content-Length header field is present in the response, its + value MUST match the actual number of OCTETs transmitted in the + message-body. + - Date + - ETag and/or Content-Location, if the header would have been sent + in a 200 response to the same request + - Expires, Cache-Control, and/or Vary, if the field-value might + differ from that sent in any previous response for the same + variant + + If the 206 response is the result of an If-Range request that used a + strong cache validator (see section 13.3.3), the response SHOULD NOT + include other entity-headers. If the response is the result of an + If-Range request that used a weak validator, the response MUST NOT + include other entity-headers; this prevents inconsistencies between + cached entity-bodies and updated headers. Otherwise, the response + MUST include all of the entity-headers that would have been returned + with a 200 (OK) response to the same request. + + A cache MUST NOT combine a 206 response with other previously cached + content if the ETag or Last-Modified headers do not match exactly, + see 13.5.4. + + A cache that does not support the Range and Content-Range headers + MUST NOT cache 206 (Partial) responses.") + +(DEFCONSTANT +MULTIPLE-CHOICES+ + 300 + "The requested resource corresponds to any one of a set of + representations, each with its own specific location, and agent- + driven negotiation information (section 12) is being provided so that + the user (or user agent) can select a preferred representation and + redirect its request to that location. + + Unless it was a HEAD request, the response SHOULD include an entity + containing a list of resource characteristics and location(s) from + which the user or user agent can choose the one most appropriate. The + entity format is specified by the media type given in the Content- + Type header field. Depending upon the format and the capabilities of + + the user agent, selection of the most appropriate choice MAY be + performed automatically. However, this specification does not define + any standard for such automatic selection. + + If the server has a preferred choice of representation, it SHOULD + include the specific URI for that representation in the Location + field; user agents MAY use the Location field value for automatic + redirection. This response is cacheable unless indicated otherwise.") + +(DEFCONSTANT +MOVED-PERMANENTLY+ + 301 + "The requested resource has been assigned a new permanent URI and any + future references to this resource SHOULD use one of the returned + URIs. Clients with link editing capabilities ought to automatically + re-link references to the Request-URI to one or more of the new + references returned by the server, where possible. This response is + cacheable unless indicated otherwise. + + The new permanent URI SHOULD be given by the Location field in the + response. Unless the request method was HEAD, the entity of the + response SHOULD contain a short hypertext note with a hyperlink to + the new URI(s). + + If the 301 status code is received in response to a request other + than GET or HEAD, the user agent MUST NOT automatically redirect the + request unless it can be confirmed by the user, since this might + change the conditions under which the request was issued. + Note: When automatically redirecting a POST request after + receiving a 301 status code, some existing HTTP/1.0 user agents + will erroneously change it into a GET request.") + +(DEFCONSTANT +FOUND+ + 302 + "The requested resource resides temporarily under a different URI. + Since the redirection might be altered on occasion, the client SHOULD + continue to use the Request-URI for future requests. This response + is only cacheable if indicated by a Cache-Control or Expires header + field. + + The temporary URI SHOULD be given by the Location field in the + response. Unless the request method was HEAD, the entity of the + response SHOULD contain a short hypertext note with a hyperlink to + the new URI(s). + + If the 302 status code is received in response to a request other + than GET or HEAD, the user agent MUST NOT automatically redirect the + request unless it can be confirmed by the user, since this might + change the conditions under which the request was issued. + Note: RFC 1945 and RFC 2068 specify that the client is not allowed + to change the method on the redirected request. However, most + existing user agent implementations treat 302 as if it were a 303 + response, performing a GET on the Location field-value regardless + of the original request method. The status codes 303 and 307 have + been added for servers that wish to make unambiguously clear which + kind of reaction is expected of the client.") + +(DEFCONSTANT +SEE-OTHER+ + 303 + "The response to the request can be found under a different URI and + SHOULD be retrieved using a GET method on that resource. This method + exists primarily to allow the output of a POST-activated script to + redirect the user agent to a selected resource. The new URI is not a + substitute reference for the originally requested resource. The 303 + response MUST NOT be cached, but the response to the second + (redirected) request might be cacheable. + + The different URI SHOULD be given by the Location field in the + response. Unless the request method was HEAD, the entity of the + response SHOULD contain a short hypertext note with a hyperlink to + the new URI(s). + Note: Many pre-HTTP/1.1 user agents do not understand the 303 + status. When interoperability with such clients is a concern, the + 302 status code may be used instead, since most user agents react + to a 302 response as described here for 303.") + +(DEFCONSTANT +NOT-MODIFIED+ + 304 + "If the client has performed a conditional GET request and access is + allowed, but the document has not been modified, the server SHOULD + respond with this status code. The 304 response MUST NOT contain a + message-body, and thus is always terminated by the first empty line + after the header fields. + + The response MUST include the following header fields: + - Date, unless its omission is required by section 14.18.1 + + If a clockless origin server obeys these rules, and proxies and + clients add their own Date to any response received without one (as + already specified by [RFC 2068], section 14.19), caches will operate + correctly. + - ETag and/or Content-Location, if the header would have been sent + in a 200 response to the same request + - Expires, Cache-Control, and/or Vary, if the field-value might + differ from that sent in any previous response for the same + variant + + If the conditional GET used a strong cache validator (see section + 13.3.3), the response SHOULD NOT include other entity-headers. + Otherwise (i.e., the conditional GET used a weak validator), the + response MUST NOT include other entity-headers; this prevents + inconsistencies between cached entity-bodies and updated headers. + + If a 304 response indicates an entity not currently cached, then the + cache MUST disregard the response and repeat the request without the + conditional. + + If a cache uses a received 304 response to update a cache entry, the + cache MUST update the entry to reflect any new field values given in + the response.") + +(DEFCONSTANT +USE-PROXY+ + 305 + "The requested resource MUST be accessed through the proxy given by + the Location field. The Location field gives the URI of the proxy. + The recipient is expected to repeat this single request via the + proxy. 305 responses MUST only be generated by origin servers. + Note: RFC 2068 was not clear that 305 was intended to redirect a + single request, and to be generated by origin servers only. Not + observing these limitations has significant security consequences.") + +(DEFCONSTANT +TEMPORARY-REDIRECT+ + 307 + "The requested resource resides temporarily under a different URI. + Since the redirection MAY be altered on occasion, the client SHOULD + continue to use the Request-URI for future requests. This response + is only cacheable if indicated by a Cache-Control or Expires header + field. + + The temporary URI SHOULD be given by the Location field in the + response. Unless the request method was HEAD, the entity of the + response SHOULD contain a short hypertext note with a hyperlink to + the new URI(s) , since many pre-HTTP/1.1 user agents do not + understand the 307 status. Therefore, the note SHOULD contain the + information necessary for a user to repeat the original request on + the new URI. + + If the 307 status code is received in response to a request other + than GET or HEAD, the user agent MUST NOT automatically redirect the + request unless it can be confirmed by the user, since this might + change the conditions under which the request was issued.") + +(DEFCONSTANT +BAD-REQUEST+ + 400 + "The request could not be understood by the server due to malformed + syntax. The client SHOULD NOT repeat the request without + modifications.") + +(DEFCONSTANT +UNAUTHORIZED+ + 401 + "The request requires user authentication. The response MUST include a + WWW-Authenticate header field (section 14.47) containing a challenge + applicable to the requested resource. The client MAY repeat the + request with a suitable Authorization header field (section 14.8). If + the request already included Authorization credentials, then the 401 + response indicates that authorization has been refused for those + credentials. If the 401 response contains the same challenge as the + prior response, and the user agent has already attempted + authentication at least once, then the user SHOULD be presented the + entity that was given in the response, since that entity might + include relevant diagnostic information. HTTP access authentication + is explained in \"HTTP Authentication: Basic and Digest Access + Authentication\" [43].") + +(DEFCONSTANT +PAYMENT-REQUIRED+ 402 "This code is reserved for future use.") + +(DEFCONSTANT +FORBIDDEN+ + 403 + "The server understood the request, but is refusing to fulfill it. + Authorization will not help and the request SHOULD NOT be repeated. + If the request method was not HEAD and the server wishes to make + public why the request has not been fulfilled, it SHOULD describe the + reason for the refusal in the entity. If the server does not wish to + make this information available to the client, the status code 404 + (Not Found) can be used instead.") + +(DEFCONSTANT +NOT-FOUND+ + 404 + "The server has not found anything matching the Request-URI. No + indication is given of whether the condition is temporary or + permanent. The 410 (Gone) status code SHOULD be used if the server + knows, through some internally configurable mechanism, that an old + resource is permanently unavailable and has no forwarding address. + This status code is commonly used when the server does not wish to + reveal exactly why the request has been refused, or when no other + response is applicable.") + +(DEFCONSTANT +METHOD-NOT-ALLOWED+ + 405 + "The method specified in the Request-Line is not allowed for the + resource identified by the Request-URI. The response MUST include an + Allow header containing a list of valid methods for the requested + resource.") + +(DEFCONSTANT +NOT-ACCEPTABLE+ + 406 + "The resource identified by the request is only capable of generating + response entities which have content characteristics not acceptable + according to the accept headers sent in the request. + + Unless it was a HEAD request, the response SHOULD include an entity + containing a list of available entity characteristics and location(s) + from which the user or user agent can choose the one most + appropriate. The entity format is specified by the media type given + in the Content-Type header field. Depending upon the format and the + capabilities of the user agent, selection of the most appropriate + choice MAY be performed automatically. However, this specification + does not define any standard for such automatic selection. + Note: HTTP/1.1 servers are allowed to return responses which are + not acceptable according to the accept headers sent in the + request. In some cases, this may even be preferable to sending a + 406 response. User agents are encouraged to inspect the headers of + an incoming response to determine if it is acceptable. + + If the response could be unacceptable, a user agent SHOULD + temporarily stop receipt of more data and query the user for a + decision on further actions.") + +(DEFCONSTANT +PROXY-AUTHENTICATION-REQUIRED+ + 407 + "This code is similar to 401 (Unauthorized), but indicates that the + client must first authenticate itself with the proxy. The proxy MUST + return a Proxy-Authenticate header field (section 14.33) containing a + challenge applicable to the proxy for the requested resource. The + client MAY repeat the request with a suitable Proxy-Authorization + header field (section 14.34). HTTP access authentication is explained + in \"HTTP Authentication: Basic and Digest Access Authentication\" + [43].") + +(DEFCONSTANT +REQUEST-TIMEOUT+ + 408 + "The client did not produce a request within the time that the server + was prepared to wait. The client MAY repeat the request without + modifications at any later time.") + +(DEFCONSTANT +CONFLICT+ + 409 + "The request could not be completed due to a conflict with the current + state of the resource. This code is only allowed in situations where + it is expected that the user might be able to resolve the conflict + and resubmit the request. The response body SHOULD include enough + + information for the user to recognize the source of the conflict. + Ideally, the response entity would include enough information for the + user or user agent to fix the problem; however, that might not be + possible and is not required. + + Conflicts are most likely to occur in response to a PUT request. For + example, if versioning were being used and the entity being PUT + included changes to a resource which conflict with those made by an + earlier (third-party) request, the server might use the 409 response + to indicate that it can't complete the request. In this case, the + response entity would likely contain a list of the differences + between the two versions in a format defined by the response + Content-Type.") + +(DEFCONSTANT +GONE+ + 410 + "The requested resource is no longer available at the server and no + forwarding address is known. This condition is expected to be + considered permanent. Clients with link editing capabilities SHOULD + delete references to the Request-URI after user approval. If the + server does not know, or has no facility to determine, whether or not + the condition is permanent, the status code 404 (Not Found) SHOULD be + used instead. This response is cacheable unless indicated otherwise. + + The 410 response is primarily intended to assist the task of web + maintenance by notifying the recipient that the resource is + intentionally unavailable and that the server owners desire that + remote links to that resource be removed. Such an event is common for + limited-time, promotional services and for resources belonging to + individuals no longer working at the server's site. It is not + necessary to mark all permanently unavailable resources as \"gone\" or + to keep the mark for any length of time -- that is left to the + discretion of the server owner.") + +(DEFCONSTANT +LENGTH-REQUIRED+ + 411 + "The server refuses to accept the request without a defined Content- + Length. The client MAY repeat the request if it adds a valid + Content-Length header field containing the length of the message-body + in the request message.") + +(DEFCONSTANT +PRECONDITION-FAILED+ + 412 + "The precondition given in one or more of the request-header fields + evaluated to false when it was tested on the server. This response + code allows the client to place preconditions on the current resource + metainformation (header field data) and thus prevent the requested + method from being applied to a resource other than the one intended.") + +(DEFCONSTANT +REQUEST-ENTITY-TOO-LARGE+ + 413 + "The server is refusing to process a request because the request + entity is larger than the server is willing or able to process. The + server MAY close the connection to prevent the client from continuing + the request. + + If the condition is temporary, the server SHOULD include a Retry- + After header field to indicate that it is temporary and after what + time the client MAY try again.") + +(DEFCONSTANT +REQUEST-URI-TOO-LONG+ + 414 + "The server is refusing to service the request because the Request-URI + is longer than the server is willing to interpret. This rare + condition is only likely to occur when a client has improperly + converted a POST request to a GET request with long query + information, when the client has descended into a URI \"black hole\" of + redirection (e.g., a redirected URI prefix that points to a suffix of + itself), or when the server is under attack by a client attempting to + exploit security holes present in some servers using fixed-length + buffers for reading or manipulating the Request-URI.") + +(DEFCONSTANT +UNSUPPORTED-MEDIA-TYPE+ + 415 + "The server is refusing to service the request because the entity of + the request is in a format not supported by the requested resource + for the requested method.") + +(DEFCONSTANT +REQUESTED-RANGE-NOT-SATISFIABLE+ + 416 + "A server SHOULD return a response with this status code if a request + included a Range request-header field (section 14.35), and none of + the range-specifier values in this field overlap the current extent + of the selected resource, and the request did not include an If-Range + request-header field. (For byte-ranges, this means that the first- + byte-pos of all of the byte-range-spec values were greater than the + current length of the selected resource.) + + When this status code is returned for a byte-range request, the + response SHOULD include a Content-Range entity-header field + specifying the current length of the selected resource (see section + 14.16). This response MUST NOT use the multipart/byteranges content- + type.") + +(DEFCONSTANT +EXPECTATION-FAILED+ + 417 + "The expectation given in an Expect request-header field (see section + 14.20) could not be met by this server, or, if the server is a proxy, + the server has unambiguous evidence that the request could not be met + by the next-hop server.") + +(DEFCONSTANT +INTERNAL-SERVER-ERROR+ + 500 + "The server encountered an unexpected condition which prevented it + from fulfilling the request.") + +(DEFCONSTANT +NOT-IMPLEMENTED+ + 501 + "The server does not support the functionality required to fulfill the + request. This is the appropriate response when the server does not + recognize the request method and is not capable of supporting it for + any resource.") + +(DEFCONSTANT +BAD-GATEWAY+ + 502 + "The server, while acting as a gateway or proxy, received an invalid + response from the upstream server it accessed in attempting to + fulfill the request.") + +(DEFCONSTANT +SERVICE-UNAVAILABLE+ + 503 + "The server is currently unable to handle the request due to a + temporary overloading or maintenance of the server. The implication + is that this is a temporary condition which will be alleviated after + some delay. If known, the length of the delay MAY be indicated in a + Retry-After header. If no Retry-After is given, the client SHOULD + handle the response as it would for a 500 response. + Note: The existence of the 503 status code does not imply that a + server must use it when becoming overloaded. Some servers may wish + to simply refuse the connection.") + +(DEFCONSTANT +GATEWAY-TIMEOUT+ + 504 + "The server, while acting as a gateway or proxy, did not receive a + timely response from the upstream server specified by the URI (e.g. + HTTP, FTP, LDAP) or some other auxiliary server (e.g. DNS) it needed + to access in attempting to complete the request. + Note: Note to implementors: some deployed proxies are known to + return 400 or 500 when DNS lookups time out.") + +(DEFCONSTANT +HTTP-VERSION-NOT-SUPPORTED+ + 505 + "The server does not support, or refuses to support, the HTTP protocol + version that was used in the request message. The server is + indicating that it is unable or unwilling to complete the request + using the same major version as the client, as described in section + 3.1, other than with this error message. The response SHOULD contain + an entity describing why that version is not supported and what other + protocols are supported by that server.") diff --git a/src/storage.lisp b/src/storage.lisp new file mode 100644 index 0000000..987ad4b --- /dev/null +++ b/src/storage.lisp @@ -0,0 +1,73 @@ +;;; (in-package :cl-user) +(defpackage #:rails-to-caveman.storage + (:use #:cl) + (:shadow #:write + #:read + #:remove + #:probe-file)) +(in-package #:rails-to-caveman.storage) + +(defstruct (file (:type vector)) + name + size + content-type) + +(defun prin1-to-base64-string (object) + ;;; SOMETHING IS CALLING THIS AND NOT PROPERLY. YOU ARE UP TO HERE. + (cl-base64:string-to-base64-string (prin1-to-string object))) + +(defun read-from-base64-string(string) + (values (read-from-string + (cl-base64:base64-string-to-string string)))) + +(defun make-storage-pathname (id subdirectory &optional file) + (merge-pathnames (format nil "storage/~A/~A/~@[~A~]" + id + subdirectory + (when file (prin1-to-base64-string file))) + rails-to-caveman.config::*application-root*)) + +(defun write (stream id subdirectory file) + ;; (let ((path (ensure-directories-exist + ;; (make-storage-pathname id subdirectory file)))) + (let ((path "/home/craig/Desktop/test.png")) + (with-open-file (s path + :direction :output + :if-does-not-exist :create + :element-type '(unsigned-byte 8) + :if-exists nil) + (write-sequence (slot-value stream 'vector) s :start 0)))) + ;; (if s + ;; (write-sequence (slot-value stream 'vector) s) + ;; (warn "File already exists ~S~&Ignored." path)))) + +(defun read (id subdirectory file) + (with-open-file (s (make-storage-pathname id subdirectory file) + :element-type '(unsigned-byte 8)) + (let* ((length (file-length s)) + (buffer (make-array length + :element-type '(unsigned-byte 8)))) + (read-sequence buffer s) + (values buffer length)))) + +(defun remove (id subdirectory file) + (delete-file (make-storage-pathname id subdirectory file))) + +(defun probe-file (id subdirectory file) + (cl:probe-file (make-storage-pathname id subdirectory file))) + +;;; This function requires ImageMagick so you will need to install it +;;; with 'sudo apt install imagemagick' (assuming you are on a +;;; Debian-based system). +(defun convert (id subdirectory original-file converted-file) + (let ((command (format nil "convert -geometry ~A ~A ~A" + (file-size converted-file) + (make-storage-pathname id subdirectory original-file) + (make-storage-pathname id subdirectory converted-file)))) + (let ((message (nth-value 1 + (uiop:run-program command + :ignore-error-status t + :error-output :string)))) + (when message (error message))))) + + diff --git a/src/web.lisp b/src/web.lisp index 6518b42..41156ab 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -7,7 +7,11 @@ #:rails-to-caveman.model #:sxql #:mito - #:cl-who) + #:rails-to-caveman.storage + #:cl-who + ;; #:rails-to-caveman.helpers + #:status-code) + ;; #:rfc2616-sec10) (:import-from #:rails-to-caveman.db #:connection-settings #:db @@ -32,8 +36,7 @@ (let ((articless (articles-make 5))) (format t "[INFO] ~a" articless) (render #P"index.html" `(:notice ,(flash-gethash :notice ningle:*session*) - :user,(when (hermetic:logged-in-p) - (current-user)) + :user,(when (hermetic:logged-in-p) (current-user)) ,@(roles) :token ,(token) :alert ,(flash-gethash :alert ningle:*session*) @@ -260,21 +263,84 @@ nil "/users/~D"(mito:object-id user)))))))) (setf (gethash :notice ningle:*session* "Deleted.") `(303 (:location "/users/index"))))))))) +;; Replaced in Chapter 13. +;; (defroute ("/user/:id" :method :post) +;; (&key id method) +;; (cond ((string= method "delete") +;; (delete-user +;; (acons "ID" id +;; (lack.request:request-body-parameters ningle:*request*)))) +;; ((find method '("" "post" nil) :test #'equal) +;; (post-user (acons "id" +;; id +;; (lack.request:request-body-parameters ningle:*request*)))) +;; (t `(400 (:content-type "text/plain") +;; (,(format nil "Unsupported method ~S" method)))))) + +;; Reimplemented in Chapter 13. (defroute ("/user/:id" :method :post) (&key id method) - (cond ((string= method "delete") - (delete-user - (acons "ID" id - (lack.request:request-body-parameters ningle:*request*)))) - ((find method '("" "post" nil) :test #'equal) - (post-user (acons "id" - id - (lack.request:request-body-parameters ningle:*request*)))) - (t `(400 (:content-type "text/plain") - (,(format nil "Unsupported method ~S" method)))))) + (method-case (alexandria:ensure-car method) + ("delete" (delete-user + (acons "ID" id + (lack.request:request-body-parameters ningle:*request*)))) + ("post" + (update-user + (acons "ID" id + (lack.request:request-body-parameters ningle:*request*)))))) + +(defun update-user (request) + (destructuring-bind (&rest args &key + authenticity-token + id + number + name + full-name + sex + email + administrator + image + birthday-year + birthday-month + birthday-day + &allow-other-keys) + (request-params request) + (declare (ignore + number + name + full-name + sex + email + administrator + birthday-year + birthday-month + birthday-day)) + (with-authenticity-check ((:token (car authenticity-token))) + (ensure-let ((old (mito:find-dao 'rails-to-caveman.model::user :id id))) + (let ((file (rails-to-caveman.model::filename-of old))) + (multiple-value-bind (user errors) + (validation-validate + (apply #'rails-to-caveman.model::update-instance old + :image image + `(,@(mapcar #'alexandria:ensure-car args) + :administrator "1"))) + (if errors (render "user/edit.html" + `(,@(roles) + :news ,(articles 5) + :blogs ,(entries :limit 5) + :user ,user + :token ,(token) + :errors ,errors)) + (progn (mito:save-dao user) + (unless (equal file + (ignore-errors (rails-to-caveman.model::filename-of user))) + (rails-to-caveman.model::purge user "account" file)) + (setf (gethash :notice ningle:*session*)"Updated") + `(,status-code:+see-other+ + (:location ,(format nil "/user/~D" id))))))))))) + + -;;; YOU ARE UP TO HERE: -;;; CAN'T GET THE VALIDATION TO WORK WHEN CREATING A NEW ACCOUNT. (defun post-user(request) (format t "[INFO] You have reached post-user request") (destructuring-bind @@ -520,54 +586,278 @@ nil "/users/~D"(mito:object-id user)))))))) :blogs (1 2 3 4 5) ,@(roles))))) +;; Reimplemented in Chapter 13. +;; (defroute("/account" :method :post) +;; (&key number +;; name +;; full-name +;; sex +;; birthday-year +;; birthday-month +;; birthday-day +;; email +;; (administrator "1") +;; authenticity-token) +;; (if (not (string= authenticity-token (token))) +;; '(403 (:content-type "text/plain") ("Denied")) +;; (if (not (hermetic:logged-in-p)) +;; '(401 ()) +;; (let* ((user (current-user))) +;; (setf (rails-to-caveman.model::number-of user) number +;; (rails-to-caveman.model::name-of user) name +;; (rails-to-caveman.model::full-name-of user) full-name +;; (rails-to-caveman.model::sex-of user) sex +;; (rails-to-caveman.model::birthday-of user) +;; (format nil "~A~A~A" birthday-year +;; birthday-month +;; birthday-day) +;; (rails-to-caveman.model::email-of user) email +;; (rails-to-caveman.model::administrator-of user) administrator +;; (rails-to-caveman.model::password-of user) +;; (gethash :password ningle:*session*)) +;; (multiple-value-bind (user errors) +;; (rails-to-caveman.model::validate-user user) +;; (if errors +;; `(400 () +;; (,(render "accounts/edit.html" +;; `(:user ,user +;; :errors ,errors +;; :news (1 2 3 4 5) +;; :blogs (1 2 3 4 5) +;; ,@(roles) +;; :token ,(token))))) +;; (progn (with-connection (db) +;; (mito:save-dao user) +;; (setf (gethash :notice ningle:*session*) +;; "Updated") +;; '(303 (:location "/account")))))))))) + +;; Reimplemented in Chapter 13. +#| +(defroute ("/account" :method :post) + (&rest args &key number name full-name sex email (administrator '("1")) + birthday-year birthday-month birthday-day authenticity-token image) + (declare (ignore number name full-name sex email administrator)) + (with-authenticity-check ((:token (car authenticity-token)) :logged-in) + (let* ((user (current-user)) + (image-file(rails-to-caveman.model::filename-of user))) + (multiple-value-bind (user errors) + (validation-validate (apply #'rails-to-caveman.model::update-instance + user + :password (gethash :password ningle:*session*) + :image image + (mapcar #'alexandria:ensure-car args))) + (if errors `(,status-code:+bad-request+ () + (,(render "accounts/edit.html" + `(:user ,user + :errors ,errors + :news ,(articles 5) + :blogs ,(entries :limit 5) + ,@(roles) + :token,(token))))) + (progn (unless (equal image-file + (ignore-errors(rails-to-caveman.model::filename-of user))) + (rails-to-caveman.model::purge user "account" image-file)) + (mito:save-dao user) + (setf (gethash :notice ningle:*session*)"Updated") + `(,status-code:+see-other+ (:location "/account")))))))) +|# + +;; Second Chapter 13 implementation (defroute("/account" :method :post) - (&key number - name - full-name - sex - birthday-year - birthday-month - birthday-day - email - (administrator "1") - authenticity-token) - (if (not (string= authenticity-token (token))) - '(403 (:content-type "text/plain") ("Denied")) - (if (not (hermetic:logged-in-p)) - '(401 ()) - (let* ((user (current-user))) - (setf (rails-to-caveman.model::number-of user) number - (rails-to-caveman.model::name-of user) name - (rails-to-caveman.model::full-name-of user) full-name - (rails-to-caveman.model::sex-of user) sex - (rails-to-caveman.model::birthday-of user) - (format nil "~A~A~A" birthday-year - birthday-month - birthday-day) - (rails-to-caveman.model::email-of user) email - (rails-to-caveman.model::administrator-of user) administrator - (rails-to-caveman.model::password-of user) - (gethash :password ningle:*session*)) - (multiple-value-bind (user errors) - (rails-to-caveman.model::validate-user user) - (if errors - `(400 () - (,(render "accounts/edit.html" - `(:user ,user - :errors ,errors - :news (1 2 3 4 5) - :blogs (1 2 3 4 5) - ,@(roles) - :token ,(token))))) - (progn (with-connection (db) - (mito:save-dao user) - (setf (gethash :notice ningle:*session*) - "Updated") - '(303 (:location "/account")))))))))) + (&rest args &key number name full-name sex email + (administrator '("1")) birthday-year birthday-month + birthday-day authenticity-token image remove-profile-image-p) + (declare (ignore number name full-name sex email administrator + birthday-year birthday-month birthday-day)) + (with-authenticity-check ((:token (car authenticity-token)) :logged-in) + (let* ((user (current-user)) + (image-file(rails-to-caveman.model::filename-of user))) + (multiple-value-bind (user errors) + (validation-validate (apply #'rails-to-caveman.model::update-instance user + :password (gethash :password ningle:*session*) + :image image + (mapcar #'alexandria:ensure-car args))) + (if errors `(,status-code:+bad-request+ () + (,(render "accounts/edit.html" + `(:user ,user + :errors ,errors + :news ,(articles 5) + :blogs ,(entries :limit 5) + ,@(roles) + :token,(token))))) + (progn (trivia:match* ((car remove-profile-image-p) + (equal image-file + (ignore-errors + (rails-to-caveman.model::filename-of user)))) + ((_ nil) ; when specify new one, always remove old one. + (rails-to-caveman.model::purge user "account" image-file) + (storage::write (car image) + (mito:object-id user) "account" + (make-image-file image))) + ((nil _)) ; do not remove, no new one, so do nothing. + ((_ _) ; remove old, no new one. + (setf (rails-to-caveman.model::filename-of user) nil + (rails-to-caveman.model::content-type-of user) nil) + (rails-to-caveman.model::purge user "account" image-file))) + (mito:save-dao user) + (setf (gethash :notice ningle:*session*) "Updated") + `(,status-code:+see-other+ (:location "/account")))))))) + +(defun purge (user subdirectory filename) + (let (deletedp (id (mito:object-id user))) + (dolist (pathname (uiop:directory-files + (storage::make-storage-pathname id subdirectory)) + deletedp) + (let ((file (storage::read-from-base64-string (pathname-name pathname)))) + (when (equal filename (storage::file-name file)) + (setf deletedp t) + (storage::remove id subdirectory file)))))) (defroute("/account" :method :put)() ) (defroute("/account" :method :delete)() ) +(defroute show-image "/entries/:id/images/:image-id" (&key id image-id) + (with-authenticity-check (:logged-in) + (if (null (mito:find-dao 'rails-to-caveman.model::entry :id id)) + (myway:next-route) + (if (null (mito:find-dao 'rails-to-caveman.model::entry-image + :id image-id)) + (myway:next-route) + `(,status-code:+see-other+ + (:location ,(format nil "/entries/~A/images/~A/edit" + id image-id))))))) + +(defroute add-image "/entries/:id/images/new" (&key id) + (with-authenticity-check (:logged-in) + (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id))) + (render "entry-images/new.html" + `(,@(roles) + :entry ,entry + :user ,(current-user) + :token ,(token) + :news ,(articles 5) + :blogs ,(entries :limit 5)))))) + +(defroute ("/entries" :method :post) (&key method) + (method-case method ("put" (create-entry + (lack.request:request-body-parameters + ningle:*request*))))) + +(defroute create-entry-image ("/entries/:entry-id/images" :method :put) + (&key authenticity-token entry-id image) + (with-authenticity-check ((:token (car authenticity-token)) :logged-in) + (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id entry-id))) + (multiple-value-bind (entry-image errors) + (validation-validate (make-instance + 'rails-to-caveman.model::entry-image + :entry entry + :image image)) + (let ((user (current-user))) + (if errors `(,status-code:+bad-request+() + (,(render + "entry-images/new.html" + `(,@(roles) + :errors ,errors + :entry ,entry + :user ,user + :token ,(token) + :news ,(articles 5) + :blogs ,(entries :limit 5))))) + (progn (storage::write (car image) + (mito:object-id user) + (format nil "entry~A"entry-id) + (make-image-file image)) + (mito:insert-dao entry-image) + `(,status-code:+see-other+ (:location + ,(format nil + "/entries/~A/images" + entry-id)))))))))) + +(defroute edit-entry-image "/entries/:entry-id/images/:image-id/edit" + (&key entry-id image-id) + (with-authenticity-check (:logged-in) + (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id entry-id)) + (image (mito:find-dao 'rails-to-caveman.model::entry-image :id image-id))) + (render "entry-images/edit.html" + `(,@(roles) + :token ,(token) + :user ,(current-user) + :news ,(articles 5) + :entry ,entry + :image ,image + :blogs ,(entries :limit 5)))))) + +(defroute dispatch-entry-image ("/entries/:entry-id/images/:image-id" + :method :post) + (&key method entry-id image-id) + (method-case (alexandria:ensure-car method) + ("post" (update-entry-image (acons "ENTRY-ID" entry-id + (acons "IMAGE-ID" image-id + (lack.request:request-body-parameters + ningle:*request*))))) + ("delete" (destroy-entry-image (acons "ENTRY-ID" entry-id + (acons "IMAGE-ID" image-id + (lack.request:request-body-parameters + ningle:*request*))))))) + +(defun update-entry-image (request) + (destructuring-bind (&key authenticity-token entry-id image-id image &allow-other-keys) + (request-params request) + (with-authenticity-check ((:token (car authenticity-token)) :logged-in) + (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id entry-id)) + (entry-image (mito:find-dao + 'rails-to-caveman.model::entry-image + :id image-id))) + (let ((old (rails-to-caveman.model::filename-of entry-image)) + (user (current-user)) + (subdirectory (format nil "entry~A" + (mito:object-id entry)))) + (multiple-value-bind (entry-image errors) + (validation-validate + (rails-to-caveman.model::update-instance entry-image + :image image)) + (if errors + `(,status-code:+bad-request+() + (,(render + "entry-images/edit.html" + `(,@(roles) + :user ,user + :news ,(articles 5) + :blogs ,(entries :limit 5) + :token ,(token) + :entry ,entry + :image ,entry-image + :errors ,errors)))) + (progn (unless (equal old + (rails-to-caveman.model::filename-of entry-image)) + (rails-to-caveman.model::purge user subdirectory old) + (storage::write (car image) + (mito:object-id user) + subdirectory (make-image-file image))) + (mito:save-dao entry-image) + `(,status-code:+see-other+ (:location + ,(format nil + "/entries/~A/images" + (mito:object-id entry)))))))))))) + +(defroute destroy-entry-image ("/entries/:entry-id/images/:image-id" + :method :delete) + (&key authenticity-token entry-id image-id &allow-other-keys) + (with-authenticity-check ((:token authenticity-token) :logged-in) + (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id entry-id)) + (entry-image (mito:find-dao 'rails-to-caveman.model::entry-image + :id image-id))) + (rails-to-caveman.model::purge (current-user) (format nil + "entry~A" + (mito:object-id entry)) + (rails-to-caveman.model::filename-of entry-image)) + (mito:delete-dao entry-image) + `(,status-code:+see-other+ (:location + ,(format nil + "/entries/~A/images" + (mito:object-id entry))))))) + (defroute "/password" () ; as show (if (not (hermetic:logged-in-p)) '(401 ()) @@ -889,6 +1179,43 @@ nil "/users/~D"(mito:object-id user)))))))) (mito:object-id article))))))))))))) +(defroute "/storage/:id/:subdirectory/:filename" (&key id + subdirectory + filename + size + content-type) + (let* ((original-file (storage::make-file :name filename + :content-type content-type)) + (to-load original-file)) + (when size (let ((converted-file (storage::make-file :name filename + :size size + :content-type content-type))) + (unless (storage::probe-file id subdirectory converted-file) + (storage::convert id subdirectory original-file converted-file)) + (setf to-load converted-file))) + (multiple-value-bind (content length) + (storage::read id subdirectory to-load) + `(,status-code:+ok+ (:content-type ,content-type + :content-length ,length) ,content)))) + +(defroute index-entry-image "/entries/:id/images" (&key id) + (with-authenticity-check (:logged-in) + (ensure-let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id))) + (let ((images (mito:retrieve-dao + 'rails-to-caveman.model::entry-image + :entry-id (mito:object-id entry)))) + (render "entry-images/index.html" + `(,@(roles) + :images ,(loop :for image :in images + :for i :upfrom 1 + :collect (cons image i)) + :entry ,entry + :user ,(current-user) + :token ,(token) + :news ,(articles-make 5) + :articles ,(articles-make 5) + :blogs ,(entries :limit 5) )))))) + (defroute "/about" () ;; about.html should be in the /templates directory. (render #P"about.html" '(:page-title "About"))) @@ -1246,3 +1573,156 @@ worse of all the chapters I have read up to now. `(405 (:allow "put get")(,(format nil "Unknown method ~S""post"))) |# + + +#| Contains the code in Chapter 12.5. +====================================================================== +At the time of writing, I do not know where/if the code in this +chapter is supposed to go into the main source code files of the +project. Until then, I have put the code here as a future reference +and as a place to store it until I have worked it out. +|# + +(defvar *doc* (plump:parse + (dexador:get "https://www.w3.org/protocols/rfc2616/rfc2616-sec10.html"))) + +(defun constant-forms() + (mapcon (lambda(list) + (when (equal "h3" (plump:tag-name (car list))) + (let*((position (position "h3" + (cdr list) + :test #'equal + :key #'plump:tag-name)) + (ps (subseq (cdr list) 0 position)) + (h3 (loop :for element + :across (plump:children (car list)) + :when (plump:text-node-p element) + :collect (plump:text element) + :into result + :finally (return + (string-trim " " + (apply #'concatenate 'string result))))) + (code)) + (multiple-value-bind (match-p start) + (ppcre:scan "^[0-9][0-9][0-9]" h3) + (if (and match-p (not (eql 306 + (setf code (parse-integer h3 + :junk-allowed t))))) + `((defconstant ,(read-from-string (format nil "+~A+" + (substitute #\- #\space(string-trim + " " + (ppcre::nsubseq h3 start))))) + ,code ,(string-trim '(#\newline #\space) + (remove #\return + (apply #'concatenate 'string + (mapcar #'plump:text ps))))))))))) + (let* ((vector (plump:child-elements (aref (clss:select "body" *doc*)0))) + (position (position "h3" vector :test #'equal + :key #'plump:tag-name))) + (coerce (subseq vector position)'list)))) + +#| Run the following in the REPL +(constant-forms) ; <------ enter this + +It should give you an output similar to this... + +((DEFCONSTANT +CONTINUE+ 100 + "The client SHOULD continue with its request. This interim response + is used to inform the client that the initial part of the request + has been received and has not yet been rejected by the server. The + client SHOULD continue by sending the remainder of the request or, + if the request has already been completed, ignore this + response. The server MUST send a final response after the request + has been completed. See section 8.2.3 for detailed discussion of + the use and handling of this status code.")) +|# + +(defun thunk() (let ((list (constant-forms))) + (format t "~&~(~S~)" + `(in-package :cl-user)) + (format t "~&~(~S~)" + `(defpackage #:rfc2616-sec10 (:use :cl) + (:nicknames #:status-code) + (:export ,@(mapcar #'cadr list)))) + (format t "~&~(~S~)" `(in-package #:rfc2616-sec10)) + (format t "~{~&~%~S~}" list))) + +(defmacro with-authenticity-check ((&rest check*) &body body) + (labels ((rec (list) + (if(endp list) + `(progn ,@body) + (body (caar list) + (cadar list) + (cdr list)))) + (body (key value rest) + (ecase key (:token + `(if (not (string= ,value (token))) + (throw-code status-code:+forbidden+) + ,(rec rest))) + (:logged-in `(if (not(hermetic:logged-in-p)) + (throw-code status-code:+unauthorized+) + ,(rec rest)))))) + (rec (mapcar #'alexandria:ensure-list check*)))) + +(defmacro ensure-let ((&rest bind*) &body body) + (labels ((rec(binds) + (if (endp binds) + `(progn ,@body) + (body (car binds)(cdr binds)))) + (body (bind rest) + `(let (,bind) + (if (null ,(car bind)) + (myway:next-route) ,(rec rest))))) (rec bind*))) + +(defgeneric update-instance (object &rest args)) + +(defmethod update-instance ((object standard-object )&rest args) + (loop :with initargs = (loop :for key :in args :by #'cddr :collect key) + :for slot :in (c2mop:class-slots (class-of object)) + :for keys = (intersection (c2mop:slot-definition-initargs slot) initargs) + :when (and keys (or (null (cdr keys)) (error "Dupcated initargs ~S"keys))) + :do (let ((value (getf args(car keys)))) + (unless (equal "" value) + (setf (slot-value object + (c2mop:slot-definition-name slot)) + value)))) + object) + +(define-method-combination validate() + ((primary (validate) :required t)) + (labels((rec(methods) + (if (endp (cdr methods)) + `(call-method ,(car methods) nil) + `(multiple-value-bind(o e),(rec (cdr methods)) + (values o (append e (nth-value 1 (call-method ,(car methods) nil)))))))) + (rec primary))) + +(defgeneric validate(object &key target-slots test) + (:method-combination validate)) + +(defmacro method-case (method &rest clauses) + (let ((var (gensym"VAR"))) + `(let ((,var ,method)) + (cond ,@(mapcar (lambda(clause) + `((string= ,(car clause),var),@(cdr clause))) + clauses) + (t (throw-code status-code:+method-not-allowed+)))))) + +;;; Added in Chapter 13 +;; (defmethod validation-validate validation-validate ((image image) &key target-slots test) +;; (with-check-validate (image +;; :target-slots target-slots +;; :test test) +;; ((content-type +;; (:assert (find content-type #0='("image/jpeg" "image/png" "image/gif" "image/bmp") +;; :test #'equal) +;; "must be one of ~S but ~S" #0# content-type))))) + + +;; ;;; Reimplemented in Chapter 13. +;; (defmethod validation-validate validation-validate ((object entry-image) +;; &key target-slots test) +;; (with-check-validate (object +;; :target-slots target-slots +;; :test test) +;; ((entry (:require t)) (filename (:require t))))) diff --git a/templates/accounts/edit.html b/templates/accounts/edit.html index 433057e..d577c8e 100644 --- a/templates/accounts/edit.html +++ b/templates/accounts/edit.html @@ -10,7 +10,8 @@ Go back my account - +{% endblock %} diff --git a/templates/entry-images/form.html b/templates/entry-images/form.html new file mode 100644 index 0000000..396978f --- /dev/null +++ b/templates/entry-images/form.html @@ -0,0 +1,11 @@ +{% include "shared/errors.html" %} + + + + + + + + + +
diff --git a/templates/entry-images/index.html b/templates/entry-images/index.html new file mode 100644 index 0000000..a49a167 --- /dev/null +++ b/templates/entry-images/index.html @@ -0,0 +1,50 @@ +{% extends "layouts/app.html" %} + +{% block title %}{% lisp (title! "Entry images") %}{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+

{{ entry.title }}

+ + + +{% if images %} + + + + + + + + + + + {% for (image . index) in images %} + + + + + + + {% endfor %} + +
NumberImageAlt textOperation
{{index}} + {{image.alt-text}} + {{image.alt-text}} +
+ Edit +
+ + + +
+
+
+{% else %} +

No images

+{% endif %} +{% endblock %} + diff --git a/templates/entry-images/new.html b/templates/entry-images/new.html new file mode 100644 index 0000000..3db5159 --- /dev/null +++ b/templates/entry-images/new.html @@ -0,0 +1,16 @@ +{% extends "layouts/app.html" %} + +{% block title %}{% lisp (title! "Add image") %}{% endblock %} + +{% block content %} +

{% lisp (title!) %}

+

{{entry.title}}

+ +
+ + + {% include "entry-images/form.html" %} +
+
+ +{% endblock %} diff --git a/templates/shared/user_form.html b/templates/shared/user_form.html index 24d8693..3130259 100644 --- a/templates/shared/user_form.html +++ b/templates/shared/user_form.html @@ -1,4 +1,10 @@ {% if user.id %} +
+ + + +
+ @@ -14,5 +20,17 @@ {% endif %} - + + + +
+ {% if user.filename %} +
+ +
+ {% endif %} + + + + diff --git a/templates/users/body.html b/templates/users/body.html index 21827ed..673a658 100644 --- a/templates/users/body.html +++ b/templates/users/body.html @@ -1,46 +1,54 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Number{{user.number}}
Name{{user.name}}
Full name{{user.full-name}}
Sex - {% ifequal user.sex 1 %} - Male - {% else %} - Female - {% endifequal %} -
Birthday - {{ user.birthday| - lisp: local-time:timestamp-to-universal| - date: ((:year 4)"/"(:month 2)"/"(:day 2)) }} -
Mail adress{{user.email}}
administrator - {% if user.administrator %} - Yes - {% else %} - No - {% endif %} -
Profile image + {% if user.filename %} + + {% endif %} +
Number{{user.number}}
Name{{user.name}}
Full name{{user.full-name}}
Sex + {% ifequal user.sex 1 %} + Male + {% else %} + Female + {% endifequal %} +
Birthday + {{ user.birthday| + lisp: local-time:timestamp-to-universal| + date: ((:year 4)"/"(:month 2)"/"(:day 2)) }} +
Mail adress{{user.email}}
administrator + {% if user.administrator %} + Yes + {% else %} + No + {% endif %} +
diff --git a/templates/users/edit.html b/templates/users/edit.html index 8926316..624b165 100644 --- a/templates/users/edit.html +++ b/templates/users/edit.html @@ -10,7 +10,7 @@ Back to user detail -
diff --git a/templates/users/new.html b/templates/users/new.html index d816fe0..4e50610 100644 --- a/templates/users/new.html +++ b/templates/users/new.html @@ -6,7 +6,8 @@ {% block content %}

{% lisp (title!) %}

{{user}}

- +