elserv-0.4.0+0.20011203cvs/0042755000175000017500000000000007402710022012643 5ustar bg66bg66elserv-0.4.0+0.20011203cvs/icons/0042755000175000017500000000000007402707643013775 5ustar bg66bg66elserv-0.4.0+0.20011203cvs/icons/Anniversary.gif0100644000175000017500000000023007323217667016757 0ustar bg66bg66GIF89aeqQ!Made with GIMP! ,KxP8=H!dTŧR8,j}ܸ˰sĆv N&Y +`;elserv-0.4.0+0.20011203cvs/icons/Anniversary.png0100644000175000017500000000051407323217667017003 0ustar bg66bg66PNG  IHDRagAMA a pHYs  tIME['IDATx 0D!F``Ia6 4,AtGAbbcHNrmȫQ;DUE0<ϳO]CRX6KԆir$d'߇* @n؞&F2$ѳ^{b5!xaXo>{5$d1^ d!vBN$Q % :Qso@:7ȓ{'8 ~/IENDB`elserv-0.4.0+0.20011203cvs/icons/Birthday.gif0100644000175000017500000000021607323217667016230 0ustar bg66bg66GIF89a(!Made with GIMP! ,Ax(y(eA7 xC2p2a@u 0 A`l&Ŧ2,d{H;elserv-0.4.0+0.20011203cvs/icons/Birthday.png0100644000175000017500000000032507323217667016250 0ustar bg66bg66PNG  IHDRagAMA a pHYs  @AtIME d΄dIDATxc`T61 6v#Hb3001(@Hl|~éY`dD؋$"lbxӸP6 uwD#;IKIENDB`elserv-0.4.0+0.20011203cvs/icons/Business.gif0100644000175000017500000000020607323217667016254 0ustar bg66bg66GIF89ayeIϪyϖ!Made with GIMP! ,9H0`w $CpW*m5rr+9Eԑ;elserv-0.4.0+0.20011203cvs/icons/Business.png0100644000175000017500000000034207323217667016274 0ustar bg66bg66PNG  IHDRagAMA a pHYs  tIMEj9qIDATxc`0bLM}v ,4?!LT}00q DFFN,0p1Q3  Bմd@qB"S&WIENDB`elserv-0.4.0+0.20011203cvs/icons/CheckBox.gif0100644000175000017500000000017707323217667016156 0ustar bg66bg66GIF89aqqq!Made with GIMP! ,2H 0J؊*HYjgqȶsmt?"4(E;elserv-0.4.0+0.20011203cvs/icons/CheckBox.png0100644000175000017500000000027107323217667016170 0ustar bg66bg66PNG  IHDRagAMA a pHYs  #utIME^HIDATxc`0Bg I.H,d`````"Z,`ԀQb þ}I9 :IENDB`elserv-0.4.0+0.20011203cvs/icons/CheckedBox.gif0100644000175000017500000000021607323217667016461 0ustar bg66bg66GIF89aqqq羾!Made with GIMP! ,Ax 0Jx"k]D(U0U`$[ڒ3qx;U/ GX[9N1XXcH;elserv-0.4.0+0.20011203cvs/icons/CheckedBox.png0100644000175000017500000000036707323217667016507 0ustar bg66bg66PNG  IHDRagAMA a pHYs  #utIME IDATx GC9a9Hrj$;$G AC9161_ ^T#{ IENDB`elserv-0.4.0+0.20011203cvs/icons/Conflict.gif0100644000175000017500000000015607323217667016226 0ustar bg66bg66GIF89a!Made with GIMP! ,-/Z;QTs^WUyF_Bl^:8;elserv-0.4.0+0.20011203cvs/icons/Conflict.png0100644000175000017500000000035007323217667016241 0ustar bg66bg66PNG  IHDRagAMA a pHYs  @AtIME6˦wIDATxS[ +_},ŖHVUA&lY ]dQ=XD!'Q>L"7LBtV t~tܤ*y~TD{ IENDB`elserv-0.4.0+0.20011203cvs/icons/Date.gif0100644000175000017500000000023007323217667015333 0ustar bg66bg66GIF89a ( <0IAYQiYyiy!Made with GIMP! ,3I07A`kf4}#N2_B8IENDB`elserv-0.4.0+0.20011203cvs/icons/Link.gif0100644000175000017500000000020007323217667015350 0ustar bg66bg66GIF89a00a!Made with GIMP! ,3x<3V10VYy&E$*5Uя7nEMq9I;elserv-0.4.0+0.20011203cvs/icons/Link.png0100644000175000017500000000044507323217667015402 0ustar bg66bg66PNG  IHDRagAMA a pHYs  tIME(1IDATxc`700Ho`lϟ?{!,hoocxp fs_Wq^i" Ü|rE.l􀂅 3Q;elserv-0.4.0+0.20011203cvs/icons/Party.png0100644000175000017500000000036507323217667015605 0ustar bg66bg66PNG  IHDRagAMA a pHYs  tIMEJIDATx; Dt.?U:`i *A>89Nֹ,Ԯ(I!6 , o6[PY#d c|=ƪfcPu_eV- o?R(%Nr9*IENDB`elserv-0.4.0+0.20011203cvs/icons/Private.gif0100644000175000017500000000022107323217667016070 0ustar bg66bg66GIF89aQyy0QQa00!Made with GIMP! ,Dx! zYoZI-ѠAHt0JLtóHaس:!1uL FkLV;elserv-0.4.0+0.20011203cvs/icons/Private.png0100644000175000017500000000046507323217667016121 0ustar bg66bg66PNG  IHDRagAMA a pHYs  tIMEƓIDATx!0?bY2 .0Lpy.! )n$vH:(#!J9S(r5j4E1̹7o@OA ,>E^zj5R/U(!D/Bc*e'EK1;5~/'.6VyjE&>F\c=jtIENDB`elserv-0.4.0+0.20011203cvs/icons/Vacation.gif0100644000175000017500000000021507323217667016225 0ustar bg66bg66GIF89a!Made with GIMP! ,@x ,@+-Seaxd&`0 12}7>N㱨(aX|,;IkX݂ {mhڭuO[?>28V ;elserv-0.4.0+0.20011203cvs/icons/article.png0100644000175000017500000000042507323217667016126 0ustar bg66bg66PNG  IHDRagAMA a pHYs  ~tIME0 (cIDATxQ Dgܤ{=؏um;L')vz!@Uk($H~ŃpTu 5hFP-頁O{C@I ĩ+:cb!N428T"?%5JEjF{#WOyp|V"kIENDB`elserv-0.4.0+0.20011203cvs/icons/back.gif0100644000175000017500000000033007324220424015341 0ustar bg66bg66GIF89afff333!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!,K#j3Si7Nvt7*EnXm/5FPxƤl(N ڌ:@VUϋ;elserv-0.4.0+0.20011203cvs/icons/background.gif0100644000175000017500000002047007323217667016605 0ustar bg66bg66GIF87add'#=N,B5Ph".=3CT #7#7H/F[4B#1.=N,=4J[-9H(7HIaw)D[APh"4B)=)71=1(=N.CT:Ja#1,=#8T 1)?[$=:Pa5Ga/A[/H5Kh);T(3B)7/H#2H3ET#:H5N'=.?N/=(:HAWo2H 1(@N&1/=T/D[#7,B#;T!7)A['=;Qh5Nh(4H)=4F[#:N7N.@T.B(:N3N)@T'7.BATo;Nh !7,ddQfLbef*JeWSQfddTeQTMTffTSi*aaTWd*W edTedG SMedQSTPde.QeSPf ;Die*bӡfQJP*eeT,TS̵Me9TdG_Y`LG$hi tcr Se4qef,`FڌEQ֔+eش"ALPbCb6 C2 Tt9 9P,o4)I(MNqS(BC(TM+A**h`2@^0r jߠMp`Z&j%aaFE.~ 1HsY jF ( ,XЌI*vA,o&4Vˌ` k"2#GdVFP+2&ӟj=9F P)ET EUjurdN-ZQD-T%Oz4AE;͘20 K 7iYdWA ) f`mQAHDIp [A *@'Y [åQt~b$<\S\ub.P %D1 D'ꤡQƮ!J;KI 8AJX/j(h 0%XfPzQX<Yy_ ]:P@L,aaF\,M@Eq_FQ '#P3* 1 4‚RB$( #[4 FzCj+A-&YXHd#29N ݙ@r` L p@ j0(Y81d 4H.r5Lԣ%XS=we 8i0 I:89A^ XhS~3 4 V,Ʃ1xX$ƈIH71?)( h;x|WT` <@Nhʨ%3*A U` ` )y&Pe@"$>( I, vH,QM 3ĠpOeB`4X >jp"a YCW10CPDЋH @@pY[ ѓ)< `˖P0B!@cA&aJڠL\ U؂|,t Y< * # =E2@I (8 `!̪vߙWp:Q`WJANeahB"02$ "DjS^B e}fУx3XC2` `YqA4XPL0` a,+a3@x V+(lضY@`/^h6H V8+`f5Q$qFM0 h\ VhB6 #8 `PTƀeZ+ DU301\ i:` (R\hBL`3`4  _Px`9Џ L }AW "A0  &픳P-l #CZ5J$E$aB|$ :c%,|b@v+XAAAL (BAeqry~ 8A%Cu n H'*M(! ]`?6@txf Z!NB;h6%ViHb-,hj:\ 6|0=e/(t3 3 CNy !Gf@rT#`w(]qG=:B0XLT4C^((iU@ WEѰMF!|@A Lй #0 ?CeX2w>`F@K@USfX51dYWQ 8C`gnVkPP Iv>`_"6a Fgf;KpQ ;40 zaycdvbA$P P.dJ2T3bS)Hasho VR'~8Bbj52e`ӀeZbšt1CNQa`H*@%TJ !PWM1CpX@YrRU] ]$w2"IJ Ow! H`P|Q ;_Spr0[H,ezw՗M' ]"F7^ ov!$~̐J0R-#  p~`96"^Rj ӇeHpC(%(a`5 iPiRd<;W( e! Os>W}25Oc6'JJW 2#Jb(%y12Cs*(WLD.. 唀 ףIjjJF<7aJR tJQS-eTpqYHb b3#Zg0} 4a""PNPi`McSq C SXS0!C@e0 fHG>"V$EPLN`"J"vde樟5Mp P@=/]d 2r |Sm]5iN~[ a:`,rq ^ 5pcV,X ӰLS@@PXPt#ՂBeK^<] %IR<@i6bPhf_tKɢa 9s.p @ pXP(NƀHKf#3,jU7vUIgqH i2:C,*@<6?[$߂0>Fs <d,,yU!WIPXVhӗ8,]S 0 ``bcS:&TT# "<]u-PVteV%M\-Ag;L`[>l:/^c7 hp=F5;p9 6&30OP cdHEieLMT.: N t9s!T9@K;p 9TÔX:9OAFLbh`YV+η@[(;>PP4px9 Kcyo1F&7O@TƾBCg.څ.ne56EU1QF5s0QvPP51u`v0ss`fFe[Z6u5U41Se46a5dVueuEe6S6q@UcVAqӄIEv SCVA#W.023T<a0d]nӄa<#Yv8 R Ao F1xNAHP+LA ˍ6 .G*a)sHN'`'Kd4 p(U :$ X60*0 $ +h LLPMaNIe; XpG4 ("6z 0$, Y`Yh$ "AL`e1Q(B10 "H%D4pV{PB`La"!Vden&PAC|E&@\P$a LpBaH8CJjZ@&2;f"/hc;Ka!Iz3`V <GT0T` &p/)!ehL` 8 Cm`UR#s״P d+ߘyJ6U H (+WJ8`5P6z*`l ()x61Aa@&|A-q`HS`c/8bX amXjd9~0L4AWx` & D,*D1F Wa@A(\0YIeW04p$;DV(^$!X2 Xгr GfhpL,b.& C dA"`PJDBa bSb0]=EǾpH Iȑ0Y a2؈j(<s YRx BhhW*ohssozpNjT ?B{`PpaixF@b/  # (%W'$F[Z ^,D>s2d`d$'`u6ˆ\Zv  pb %/stkT^NA#2 < ya5Ef`**tB ҇& nLq_90A  . @1-9 G&&i{Q,202I s^􏙼K*<`_6h O|sgw934 *X1vA#!jHc2NXo @5X`#`Op0ihH(֠Ҙa݀ )`0cf36#X@Rr ?V16p ;elserv-0.4.0+0.20011203cvs/icons/background.png0100644000175000017500000001657007323217667016632 0ustar bg66bg66PNG  IHDRddGT/D[#7,B#;T!7)A['=;Qh5Nh(4H)=4F[#:N7N.@T.B(:N3N)@T'7.BATo;Nh !7 ~bKGDH pHYs  ~tIME [ MIDATx%z{6.;Y`iw,$4HORl!~ cy$- ^>:bDt;EZek"u5z9i;]jos݉t<-459g,5YG}pyY( M2k)Ԝ) "m=;²_ܻ<6?Ae9ZSW"}R#k' 3U$ǎ'%b/3193eȨZ3c;ϝn's-K8wDfKG?r+d5bo3:ڱ$waÙP,yΛR!hc+Iۄ5duF-r(ӝ vʔcVJ|׸Dv/ Nm8!'c T#=?6Njz\(:]&D c9dR`Q3wC6poE4;mIF [↕wEB9 vcw8`Rg(]QXVy(22 3.:;|f jO8 E +$˳ڡIQŽRsx+CrSĚ>+Lu.3 ޓS#XR~~EVnb!d>G5>CFBr_ga[j\qco.tTF*~E|RcR')exZ<`F#.s$,4E8*ݾj}n:~&C6K ly`B' ;)3OI`բIdX XD'Čk[/\,Cg<.o&(*!%ք.xPEH. et AD8gSS=jX1>s'za8X6{LQEp^*PbGԶgDz6% Ղ-T7=wGXWTd=Ћ'z+SZSvvw ۯ[[vWcbߓIJo:.S^3އ(e\ogl5LBqx6!32$M55׾BOQv1ei[;D|v+Li,h{ѹU)wC .jK/[}TKׇe>-"`/şmklvrfolp %ĽȷW^b~PNRFXu\X "irl#;~-q vh_J@^XMK?w$`!3e}ͫ5:bSf^Y7̧ͬ!R64d_jM2g ,qqIP5v [SCƜ~qRFo~Iyn90^ІTn(6I1WzYCIeW*y˪mϯo۟ۑF[3ޠ&-i( Ddlp=^;4S5ދoMܴNFwf#3xWtyK#ffM#ސͼtq*T$qOJ[JJθܚ/0i;p.ޜzz`>H꾾0f4 E`}R~'A, _,i4afneoQd-@Π.|M)IdZ.-dQtו.pluG7H}"J".|Cm۟[1a*8_ Gd}dcbndGQ-?^p`YvZNOUqq< ob\I#ePgU[B-HR7r!Zqj`B5`bJ@LCڡn #"Mp M%%:~?چKOZB'P!N8L*!BNd=hS9l!MլDXbxKC*fu./W-j.QDuvRr5J;= ̤ш XUVV+L;(x8,IqzۭsZKֳz(wx!g Xs.S]!-W{h=wHk~y1O, ӥ 2j݅*NRC͂7 2{/b0^*twhunO_lm?GP(ҋB46EFa|9QQ9?:R 7Ry6'xPIf!=” L ,h2-KC@ŠD70a$-Sy+;vNr#=]HyTbM|1M0KEϣqWU-;H!Y02Daym4~ ͼ{q|^@ò'⛐|@Q"GA߂9L ځ9+<ade۟FqAQP4|@O -dCҕS2W%Y "kp&1@:",bn粔mv6̌y;cnP|C[a p!ꐐY;X}~"7wB9ܶ~;#9^;vЊJTj="{.=u D>!!n̍,)g#5]ikArĽйU"Lm"CpuǨL 4d~c6f;z4wMIez`aƚG*ة8L 8MJCT3P[?90;>mgi]O_4+JcdSg}ٰ0uRoN{0{ٹ6mu~>kl_n?o·@۟ mj\> I:EsFmUY`hAgдTe ٛ&mt'C{Vޘ|їgؗ3-;z*xr@A-1z&Lv݆D7Cd~g?/7^;;iGj~rBcDlԱUf؎.$0I?<t?8Y_n~,ו''jGä =_DEqT0){7#~z].q譹y}|ooF@ngݲkx01b} ^6>[u ZVpbFIiNg/o_Qy.*7ܭ"\:z` 6W$Xgv8[urBpGwKrñn{SGÔ A:eȖk _(b[vSt5]'phOxu^7Ѷ' bmův녊[cڵNsSʊjl 5Ȇ*uEi]7~hG}޹O Z5zB[dq4KZ$S̳5NJWk , co Q[OӰݶ``=h?! 7a5}ֵK~\zZ/R6G; (I~>~ھݎATt ^!:<##'uRj^O!Zt5]?DFGװh4B=KR* w[^~qT;/nWbrֿϽu'q>ʬt~=]O4Z [%{-;]xz 0Q4HJ<ʲ`3GqM@Qs4st%]dM`iL6~&XjrNC ZLr/xQL\ }e^SZ c߱{f` J0z7qI,>Y4'ܱၽE?Dlΐ\B;[ 1Cݙk̆5zW5]8[噿>${b@]~?=̀|"3>ug Z]Q 9q N4GiTaGS :`+<3-:GйݮOG3ߘşЭQn*y!6n+KXMȬb S8qW0mA$>_]m}ߜߞ4(EPpn\'L1eqas"+Ka7b˽6Vcx/ݘߞ7&f?2@3^6-ZvIIgv?g&Sj/;0;Ǩֽjӳ4C/28c&0jx p8`,o|d?0{x,1f/fQgkoG{)_9K2=W+Tl1 GsRB X7]x ؋wyλx-@X^]I7@,pF]y%܀È(ߝo٩i۳'*-=N_:@P UaqJN?h.̤yn q)Pf+'~+ʒbA96)c6>hA=B=75=e~#Zn}F(}A:a\꯴\Mtb#|3{'5Zclt޽ۦRJ8rh(PE3&6jSq,wi@Z{ݟ>s٢v0}"Z!&Fsn>ѡ%X-Y5 7iu!y|UX_CAl5IuO- vCCCT϶-ц!]jD"\%ɺ k?{Ƣ8?v{Xr;ciǼ$ TCrґc̦έwϿ(}l_{u>?>sWTrQLzYdiSb֣^]ٝƬ{tŧq<- ?i'IENDB`elserv-0.4.0+0.20011203cvs/icons/binary.gif0100644000175000017500000000036607324220424015736 0ustar bg66bg66GIF89a̙333!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!,iH0@$Y ]!q^ k굮jAvQh)n%Ӗ*ԂZU)􄧴9!_8s; JI;CS ;elserv-0.4.0+0.20011203cvs/icons/blank.gif0100644000175000017500000000022407324220424015532 0ustar bg66bg66GIF89a!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!,ڋ޼I;elserv-0.4.0+0.20011203cvs/icons/bomb.gif0100644000175000017500000000046407324220424015370 0ustar bg66bg66GIF89a3̻fffUUU333!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!,0IX$Ivm^I v$}ئIvDpH %r[@-45oJV1z=b@X`8o,@ۅy_,UIJghABxCJepf% UTBLW;elserv-0.4.0+0.20011203cvs/icons/c.gif0100644000175000017500000000036207324220424014670 0ustar bg66bg66GIF89a333!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!,e80 @#i;UEqeM#Wk`( t (Q!uA!֋Jq9hRZ-fN0\pt@7l+ ;elserv-0.4.0+0.20011203cvs/icons/compressed.gif0100644000175000017500000000201607324220424016610 0ustar bg66bg66GIF89af3̙f3f3ffffff3f3333f333f3f3̙f3̙̙̙̙f̙3̙ffffff3f3333f333f3̙f3̙̙f3̙f3ff̙ffff3f33̙33f333̙f3ffffff3ffff̙fff3fffffff3ffffffffffff3fff3f3f3f3ff33f3ffffff3f3333f333333̙3f3333333f3333f3f3f3ff3f33f33333333f333333333f333f3̙f3f3ffffff3f3333f333f3wUD"wUD"wUD"ݻwwwUUUDDD"""!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!$,I$`dCV #lСĄ+Z(0cC'NJI\GVbZi/aƤ@75ICϟF983O@lh%QV9L4jϩ^: 3؞K*gZ-mv}(ԧҔ%+2K$€;elserv-0.4.0+0.20011203cvs/icons/dvi.gif0100644000175000017500000000035607324220424015233 0ustar bg66bg66GIF89a333!NThis art is in the public domain. Kevin Hughes, kevinh@eit.com, September 1995!,a80 @#IjU(R'10:"(;Hhã4\6eOPʂW}es4$($J$$%5!<%P$O!"E,@Z$J%(%i!<%9%F!<%?%9$r(B $BJV$5$J$1$l$P$J$i$J$$(B $B!J(BMUST$B!K!#(B elserv-0.4.0+0.20011203cvs/COPYING0100644000175000017500000000141207325232270013677 0ustar bg66bg66Copyright (C) 2001 Yuuichi Teranishi This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. elserv-0.4.0+0.20011203cvs/ChangeLog0100644000175000017500000005173707331404612014433 0ustar bg66bg662001-07-31 Yuuichi Teranishi * es-monitor.el (elserv-monitor-function): Reject if path is not root. 2001-07-30 Yuuichi Teranishi * elserv-xmlrpc.el: Fixed comment. 2001-07-30 OHASHI Akira * ELSERV-ELS (elserv-modules-to-compile): Add elserv-negotiation. * elserv.el (toplevel): Add autoload setting for elserv-negotiation. (elserv-use-negotiation): New variable. (elserv-parse-accept-language): Move to `elserv-negotiation.el' and Rename to `elserv-negotiation-language'. (elserv-find-file): Move to `elserv-negotiation.el' and Rename to `elserv-negotiation'. (elserv-service-directory): if `elserv-use-negotiation' is non-nil, handle the content negotiation. * elserv-negotiation.el: New file. 2001-07-27 Yuuichi Teranishi * xml-rpc.el (xml-rpc-xml-list-to-value): Bind local variable `valtype' and `valvalue'. * elserv-xmlrpc.el (elserv-xmlrpc-process-request): Bind local variable `params'. * ELSERV-ELS (elserv-modules-to-compile): Added elserv-xmlrpc, es-xmlrpc, xml-rpc. * elserv.el (toplevel): Added autoload setting for elserv-xmlrpc. (elserv-default-server-name): New user option. (elserv-search-default-make-index): Ditto. (elserv-server-admin-full-name): Ditto. (elserv-server-admin-mail-address): Ditto. (elserv-buffer-search-index-buffer): New buffer local variable. (elserv-start): Setup elserv-buffer-search-index-buffer. (elserv-stop): Clean up elserv-buffer-search-index-buffer. (elserv-publish): Make search index if elserv-search-default-make-index is non-nil or (:index t) argument is specified. (elserv-search-index-buffer-name): New constant. (elserv-search-initialize): New function. (elserv-search-buffer): Ditto. (elserv-search-list-files-internal): Ditto. (elserv-search-list-files): Ditto. (elserv-search-add-index): Ditto. (elserv-search-add-directory-index): Ditto. (elserv-search): Ditto. * elserv-xmlrpc.el, es-xmlrpc.el, xml-rpc.el: New files. 2001-07-19 Yuuichi Teranishi * elserv.el (product): Up to 0.4.0. * README.ja: Update. * es-demo.el (elserv-demo-post-apropos): Fixed problem when no apropos matched. 2001-07-18 Yuuichi Teranishi * elservd: Removed. * elservd.in: New file. * Makefile (GOMI): Added elservd. * ELSERV-MK (config-ruby): New function. (config-elserv): Call `config-ruby'. (config-elserv-package): Ditto. * COPYING: New file. * es-wiki.el (elserv-wiki-function): Redirect "" to "/". * es-mhc.el (elserv-mhc-function): Don't cause an error when month is "". * es-demo.el (elserv-demo-publish): Changed name for upload. * elserv.el (elserv-make-redirect): Added argument `result'. (elserv-service-directory): Follow change above. (elserv-service-function): Don't redirect here. * ELSERV-MK: Check whether ruby is installed or not. 2001-07-17 OHASHI Akira * elserv-autoindex.el (elserv-autoindex): Simplify. (elserv-autoindex-get-icon): Don't use `assoc-if'. 2001-07-17 Yuuichi Teranishi * elserv.el (toplevel): Enclose autoloading elserv-autoindex definition with eval-and-compile. * elserv-autoindex.el (elserv-autoindex): Don't use delete-if. * ELSERV-MK, ELSERV-ELS, ELSERV-CFG, Makefile: New files. * web-custom.el (toplevel): Require mcharset. (web-custom-option-body): Use elserv-replace-in-string. * es-mhc.el (elserv-mhc/path, elserv-mhc/icon-image-alist): Moved definition. (elserv-mhc-article-function): Added local binding `charset'. * elserv.el (elserv-daemon-name): Setup default for XEmacs package. (elserv-icon-path): Set default value. (elserv-service-directory): Set argument `result'. (elserv-replace-in-string): New function. * elserv-autoindex.el (toplevel): Require elserv. (elserv-autoindex): Added argument `result'. 2001-07-17 OHASHI Akira * elserv-autoindex.el (elserv-autoindex): Fix regexp. (elserv-autoindex-get-icon): Fix directory handling. 2001-07-16 Yuuichi Teranishi * es-wiki.el (elserv-wiki-search-page): Rewrite for latest emacs-wiki. (elsesrv-wiki-compilation-finish-function): Removed. * elserv.el (elserv-service-function): Redirect "" to "/". * es-monitor.el: Removed "(require 'mcs-20)". 2001-07-16 OHASHI Akira * elserv-autoindex.el (elserv-autoindex-ignore-list): Change list contents to regexp. (elserv-autoindex): Follow changes above. (make-match-function): Abolish. (elserv-autoindex-get-icon): Implement `make-match-function'. * elserv-autoindex.el (elserv-autoindex): Simplify parent directory handlings. (elserv-autoindex-get-attr): Ditto. * es-monitor.el (toplevel): Require `mcharset' and `mcs-20'. 2001-07-16 Yuuichi Teranishi * es-monitor.el: New file. * elserv.el (elserv-publish): Added description as first argument. (elserv-execute-service-maybe): Renamed from elserv-call-service-function-maybe. (elserv-execute-service-maybe): Use intern-soft instead of intern. (elserv-service-directory): Added argument `doc'. (elserv-service-string): Ditto. (elserv-service-function): Ditto. (elserv-publish-default): Publish monitor. * es-demo.el (elserv-demo-publish): Added description. * es-wiki.el (elserv-wiki-publish): Ditto. * es-mhc.el (elserv-mhc-publish): Ditto. * es-mhc.el (elserv-mhc-icon-publish-path): New user option. (elserv-mhc-icon-path): Changed default value as elserv-icon-path. (elserv-mhc/icon-setup): Eliminated. (elserv-mhc-icon-string): Changed to use elserv-mhc-icon-publish-path. (elserv-mhc-make-todo-list): Use elserv-mhc/icon-image-alist. (elserv-mhc/icon-image-alist): New internal variable. (elserv-mhc-icon-setup): Rewritten. * elserv.el: Defcustomized. * elserv-autoindex.el (elserv-autoindex-http-header): Don't hard code icon path. (elserv-autoindex-get-icon): Ditto. (elserv-autoindex-icon-alist): Ditto; Renamed from elserv-autoindex-icon-alist. (elserv-autoindex-list-format): Added space. (elserv-autoindex): Use elserv-icon-publish-path. (elserv-autoindex-get-attr): Ditto. (elserv-autoindex-get-attr): Bind system-time-locale as "C". (elserv-autoindex-get-icon): Renamed * elserv.el (elserv-directory-autoindex): New variable (Renamed from elserv-options-indexes). (elserv-icon-path): New variable. (elserv-icon-publish-path): Ditto. (elserv-server-eol): Define as constant. (elserv-client-eor): Ditto. (elserv-service-directory): Fixed. (elserv-service-function): Fixed. (elserv-publish-default): Publish elserv-icon-path on elserv-icon-publish-path. * es-wiki.el (elserv-wiki-function): Fixed default page detection. (elserv-wiki-publish): Fixed. 2001-07-15 OHASHI Akira * elserv.el (toplevel): Autoload `elserv-autoindex'. (elserv-start): Run `elserv-start-hook'. (elserv-options-indexes): New variable. (elserv-service-directory): If `elserv-options-indexes' is Non-nil and directory has no index file, generate html index in the directory. * elserv-autoindex.el: New file. * icons/a.gif: Ditto. * icons/back.gif: Ditto. * icons/binary.gif: Ditto. * icons/blank.gif: Ditto. * icons/bomb.gif: Ditto. * icons/c.gif: Ditto. * icons/compressed.gif: Ditto. * icons/dvi.gif: Ditto. * icons/folder.gif: Ditto. * icons/image2.gif: Ditto. * icons/layout.gif: Ditto. * icons/movie.gif: Ditto. * icons/p.gif: Ditto. * icons/script.gif: Ditto. * icons/sound2.gif: Ditto. * icons/tar.gif: Ditto. * icons/tex.gif: Ditto. * icons/text.gif: Ditto. * icons/unknown.gif: Ditto. 2001-07-13 Yuuichi Teranishi * es-demo.el (elserv-demo-apropos-page): Eliminated. (elserv-demo-describe-function): Renamed from elserv-demo-function. (elserv-demo-publish): New function. (elserv-demo-start): Use it. * es-wiki.el (elsesrv-wiki-compilation-finish-function): New variable (To follow changes in latest emacs-wiki). (elserv-wiki-search-page): Use it. * elservd (toplevel): Call STDOUT.binmode for DOS environment. (Patches provided on gotoh-san's diary.) * elserv.el (elserv-package-publish): New function. * es-wiki.el (elserv-wiki-publish): New function. * es-mhc.el: Provide es-mhc with product-provide. * elserv.el: Removed comment for elserv-demo.el. * elserv-mhc.el, elserv-wiki.el, elserv-demo.el: Deleted (Renamed). * es-demo.el: Renamed from elserv-demo.el. * es-mhc.el: Renamed from elserv-mhc.el. * es-wiki.el: Renamed from elserv-wiki.el. (elserv-wiki-function): Renamed from `elserv-wiki'. * elserv.el (elserv-parse-path): Changed behavior like XEmacs. (elserv-service): Changed path analyse process. path always starts with '/'. (elserv-service-directory): Follow changes above. * elserv-wiki.el (elserv-wiki): Likewise. * elserv-mhc.el (elserv-mhc-function): Likewise. 2001-07-12 OHASHI Akira * elserv.el (elserv-service-directory): Fix. 2001-07-09 Yuuichi Teranishi * remote.el (remote-controller): Use function system-name instead of variable. * web-custom.el (web-custom): Ditto. * elserv.el (elserv-parse-path): New function. (elserv-service): Ditto. (Pointed out by "OHASHI, Akira" ) * elserv-mhc.el (elserv-mhc-face-foreground): New function. (elserv-mhc-face-background): Ditto. (elserv-mhc-string-with-face): Use above functions. (elserv-mhc-content): Ditto. (elserv-mhc-start): Use function system-name instead of variable. 2001-07-06 Yuuichi Teranishi * elserv-wiki.el (elserv-wiki): Follow changes for path. * elserv.el (elserv-define-status-code): Renamed from elserv-define-result-code (All other related portions are changed). (elserv-moved-permanently): Renamed from elserv-moved/perm. (elserv-make-redirect): Follow chage above. (elserv-moved-found): Renamed from elserv-moved/temp. (elserv-see-other): Added. (elserv-not-modified): Ditto. (elserv-process-request): Added argument `request'. (elserv-process-filter): Follow change above. (elserv-call-service-function-maybe): New inline function. (elserv-service): Search for all hierarchies of paths. (elserv-service-directory): Follow change above. (elserv-service-function): Fixed docstring. * elserv-mhc.el: New file. * remote.el: Ditto. * web-custom.el: Ditto. * icons/Anniversary.gif: Ditto. * icons/Anniversary.png: Ditto. * icons/Birthday.gif: Ditto. * icons/Birthday.png: Ditto. * icons/Business.gif: Ditto. * icons/Business.png: Ditto. * icons/CheckBox.gif: Ditto. * icons/CheckBox.png: Ditto. * icons/CheckedBox.gif: Ditto. * icons/CheckedBox.png: Ditto. * icons/Conflict.gif: Ditto. * icons/Conflict.png: Ditto. * icons/Date.gif: Ditto. * icons/Date.png: Ditto. * icons/Holiday.gif: Ditto. * icons/Holiday.png: Ditto. * icons/Link.gif: Ditto. * icons/Link.png: Ditto. * icons/Other.gif: Ditto. * icons/Other.png: Ditto. * icons/Party.gif: Ditto. * icons/Party.png: Ditto. * icons/Private.gif: Ditto. * icons/Private.png: Ditto. * icons/Vacation.gif: Ditto. * icons/Vacation.png: Ditto. * icons/article.png: Ditto. * icons/background.gif: Ditto. * icons/background.png: Ditto. 2001-05-30 Yuuichi Teranishi * elserv.el (elserv-ok): Set message as "OK". (elserv-make-redirect): Set body. (elserv-make-header): Use elserv-msg for message. (elserv-log): Fixed bug when access-log file does not exist. (elserv-parse-accept-language): New function. (elserv-find-file): Use it. (elserv-service-directory): Fixed. 2001-05-29 Yuuichi Teranishi * elservd: Assume argument number as 5. * elserv.el (elserv-bytes): Rewrite. (elserv-process-request-internal): Don't count body length if it's nil. (elserv-log): Ditto. (elserv-make-header): Don't refer body if it is nil. (elserv-start): Fixed arguments. (elserv-find-file): New function. (elserv-service-directory): Fixed problem when the directory is published as root content. (elserv-access-log-file): New variable. (elserv-access-log-max-size): Ditto. (elserv-log): Write access log to the elserv-access-log-file if specified. 2001-05-28 Yuuichi Teranishi * elservd (ElservClientSession::close): New method. (ElservClientSession::read): Ditto. (ElservClientSession::read_chunked): Ditto. (main-loop): Detect transfer-encoding header and read chunked body if it is specified. * elserv.el: Fixed "a HTTP server" => "an HTTP server". (elserv-bytes): Rewrite. (elserv-client-start): Set buffer as unibyte. (elserv-process-request-internal): Use elserv-make-header instead of elserv-make-response. (elserv-parse-request): Set buffer as unibyte. (elserv-make-header): Renamed from elserv-make-response; Don't include body. (elserv-start): Set buffer as unibyte. * elserv-demo.el (elserv-demo-upload): Set temp buffer as unibyte. * elservd (toplevel): Added 5th argument. (main-loop): Check keep_alive_timeout; Close session if bogus null request. * elserv.el (toplevel): Require 'static. (elserv-program-name): New variable. (elserv-keep-alive-timeout): Ditto. (elserv-http-version): New constant. (elserv-bytes): New alias. (elserv-method-not-allowed): Changed name. (elserv-make-result): Added argument content-length. (elserv-result-content-length): New macro. (elserv-set-result-content-length): Ditto. (elserv-version): Added optional argument. (elserv-load): Don't use default-enable-multibyte-characters. (elserv-make-response): Added Date, Accept-Range, Keep-Alive fields. (elserv-start): Added argument for elserv-keep-alive-timeout. (elserv-log): Use elserv-bytes instead of length. (elserv-request-handler): Check "Host" field when HTTP/1.1. (elserv-request-handler): Return 'Not implemented' response if method is not implemented. (elserv-handle-head): Set content-length. (elserv-publish): Added :host argument. (elserv-service): Added virtual host support. * elserv-wiki.el (elserv-wiki-publishing-footer): New variable. (elserv-wiki-render-page): Rewrite. (elserv-wiki-search-page): Added save-window-excursion. (elserv-wiki): Use elserv-wiki-publishing-footer; Use emacs-wiki-default-page for "/". * README.ja: Update. * BUGS.ja: Update. 2001-05-26 Yuuichi Teranishi * elservd: Rewrite to have only one persistent connection with emacs. * elserv.el (toplevel): Require 'poem. (toplevel): checkdoc. (elserv-max-keep-alive-requests): New variable. (elserv-identity-check): Set default as nil. (elserv-garbage-collect-every-request): Abolish. (elserv-buffer-client-process): New buffer local variable. (elserv-buffer-client-port): Ditto. (elserv-url-int-char): Abolish. (elserv-url-decode-string): Use int-char. (elserv-position): New inline function. (elserv-url-decode): Use it. (elserv-url-decode): Use substring instead of subseq. (elserv-client-start): Changed argument; Don't send response. (elserv-process-request-internal): New inline function. (elserv-process-request): Call elserv-process-request-internal. (elserv-parse-request): Rewrite. (elserv-make-response): Added argument connection. (elserv-make-response): Don't add last CRLF. (elserv-start): Added elserv-max-keep-alive-requests. (elserv-find-process): Changed regexp. (elserv-stop): kill process buffer. 2001-05-23 Yuuichi Teranishi * elserv-wiki.el: New file. * elserv-demo.el (elserv-counter-file-base): New variable. (elserv-counter): New function. (elserv-demo-counter): Ditto. (elserv-demo-start): Added counter. * elservd (toplevel): Require "thread", "timeout"; Changed argument number; Check client count; Added timeout for emacs client acception. * elserv.el (elserv-max-clients): New variable. (elserv-garbage-collect-every-request): Ditto. (elserv-url-unreserved-chars): Renamed from `elserv-cgi-url-unreserved-chars'. (elserv-make-unauthorized-basic): Added unauthorized page. (elserv-url-int-char): Renamed from elserv-cgi-int-char. (elserv-url-hex-char-p): Likewise. (elserv-url-decode-string): Likewise. (elserv-url-decode): Likewise. (elserv-load): New function. (elserv-make-directory): Ditto. (elserv-save-buffer): Ditto. (elserv-save): Ditto. (elserv-client-start): Garbage collect every request. (elserv-start): Added max client argument. (elserv-start): Make process buffer for each port. (elserv-process-port): New function. (elserv-find-process): Use it. (elserv-log): Make log buffer for each port. (elserv-log): Fixed problem when user-agent is nil. (elserv-request-handler): Don't catch error handler here. (elserv-service): Support "/" content. (elserv-service-directory): Changed checking order of auth and predicate. (elserv-service-string): Ditto. (elserv-service-function): Ditto. (elserv-service-directory): Decode path first. (elserv-publish-default): Simplify. (elserv-request-handler): Downcase method name. 2001-05-18 Yuuichi Teranishi * elserv-demo.el (elserv-demo-buffers): Replace " " as "+". * elserv.el (elserv-cgi-url-unreserved-chars): New constant. (elserv-make-predicate-from-plist): Append 'list for host-regexp list. (elserv-make-unauthorized-basic): Fixed. (elserv-cgi-int-char): New function. (elserv-cgi-hex-char-p): Ditto. (elserv-cgi-decode-string): Ditto. (elserv-cgi-decode): Ditto. (elserv-make-response): Added "\r\n" after Content-Length: field. (elserv-client-start): Display response on debug buffer; Don't send last "\r\n". (elserv-service-function): Call `elserv-cgi-decode-string' to decode path. * elserv-demo.el (elserv-demo-start): Don't quote as list. 2001-05-17 Yuuichi Teranishi * elservd (keep_alive): Abolish. (toplevel): Added identity check, added argument; Use pack('m') to encode body; Added decimal client address information to the header. * elserv-demo.el (elserv-demo-calendar): Added argument result, removed argument header-only, follow other API changes. (elserv-demo-buffers): Ditto. (elserv-demo-post-apropos): Ditto. (elserv-demo-function): Ditto. (elserv-demo-start): Added buffers-local, upload demo. * elserv.el (elserv-directory-index-file): New variable. (elserv-keep-alive): Ditto. (elserv-identity-check): Ditto. (elserv-define-result-code): Renamed from elserv-define-exception. (All other related portions are changed.) (elserv-make-result): New macro. (elserv-result-code): Ditto. (elserv-set-result-code): Ditto. (elserv-result-header): Ditto. (elserv-set-result-header): Ditto. (elserv-result-body): Ditto. (elserv-set-result-body): Ditto. (elserv-result-user): Ditto. (elserv-set-result-user): Ditto. (elserv-error): Changed argument. (with-elserv-error-handler): Follow changes above. (elserv-make-unauthorized-basic): Ditto. (elserv-make-redirect): Ditto. (elserv-parse-request): Get client's decimal address. (elserv-parse-request): Get content-type, ident. (elserv-parse-request): Decode body as base64 encoded string. (elserv-make-response): New function. (elserv-start): Add argument if elserv-identity-check is non-nil. (elserv-stop): Changed message. (elserv-log): Print logname and username. (elserv-request-handler): Call elserv-make-response. (elserv-handle-HEAD): Set body as nil. (elserv-authenticate-basic): Added argument result. (elserv-authenticate): Ditto. (elserv-check-predicate): New function. (elserv-publish): Call elserv-make-predicate-from-plist to make predicate for each service function. (elserv-service): Removed argument header-only. (elserv-make-header): Abolish. (elserv-service-directory): Added argument predicate, remove argument header-only, and check predicate. (elserv-service-string): Ditto. (elserv-service-function): Ditto, added content-type argument. 2001-05-15 Yuuichi Teranishi * elserv-demo.el (toplevel): Require w3m. (elserv-demo-start): Added authentication example. (elserv-demo-buffers): Display buffer content (According to Akihiro Arisawa san's diary.) * elserv.el (elserv-make-redirect): Abolished argument req. (elserv-service): Pass published path to each service function. (elserv-authenticate): New function. (elserv-authenticate-basic): Ditto. (toplevel): Added comment. (toplevel): Require 'cl when compile. (elserv-debug): New variable. (elserv-make-unauthorized-basic): New function. (elserv-make-redirect): Change return value. (elserv-debug): Output to debug buffer only when elserv-debug is non-nil. (elserv-parse-request): Get authorization header. (elserv-handle-GET): Changed return value. (elserv-handle-HEAD): Ditto. (elserv-handle-POST): Ditto. (elserv-publish): Process authentication setting. (elserv-publish): Changed function processing. (elserv-service-directory): Added argument auth. 2001-05-13 Yuuichi Teranishi * elserv.el: Checkdoc. 2001-05-12 Yuuichi Teranishi * elserv-demo.el: New file. * README.ja, BUGS.ja, ChangeLog, elservd, elserv.el: New file. elserv-0.4.0+0.20011203cvs/ELSERV-CFG0100644000175000017500000000056307324730751014200 0ustar bg66bg66;;; -*-Emacs-Lisp-*- ;; ELSERV-CFG: installation setting about ELSERV. ;;; Code: ;; Specify following if you don't want to install lisp files to the ;; default directory. ;(setq ELSERV_DIR "/opt/emacs/site-lisp/elserv") ;; Specify following if you don't want to install exec files to the ;; default directory. ;(setq EXEC_DIR "/opt/gnu/bin") ;;; ELSERV-CFG ends here elserv-0.4.0+0.20011203cvs/ELSERV-ELS0100644000175000017500000000146407331200502014205 0ustar bg66bg66;;; -*-Emacs-Lisp-*- ;; ELSERV-ELS: list of ELSERV modules to install ;;; Code: (defvar elserv-modules-to-compile '(elserv elserv-autoindex es-demo es-monitor remote web-custom elserv-xmlrpc es-xmlrpc xml-rpc elserv-negotiation)) (defvar elserv-modules-not-to-compile nil) (mapcar (function (lambda (cell) (let ((c-module (car cell)) (i-modules (cdr cell))) (if (module-installed-p c-module) (setq elserv-modules-to-compile (nconc elserv-modules-to-compile i-modules)) (setq elserv-modules-not-to-compile (nconc elserv-modules-not-to-compile i-modules)))))) '((emacs-wiki es-wiki) (mhc es-mhc) ;; Add modules with dependency here. )) (setq elserv-modules (append elserv-modules-to-compile elserv-modules-not-to-compile)) ;;; ELSERV-ELS ends here elserv-0.4.0+0.20011203cvs/ELSERV-MK0100644000175000017500000001154707325235720014111 0ustar bg66bg66;;; -*-Emacs-Lisp-*- ;; ELSERV-MK: installer for ELSERV. ;;; Code: (defvar default-load-path load-path) (add-to-list 'load-path (expand-file-name "../../site-lisp/apel" data-directory)) (add-to-list 'load-path (expand-file-name "." data-directory)) (condition-case nil (require 'install) (error (error "Please install APEL 8.7 or later."))) (defvar PREFIX install-prefix) (defvar LISP_BASE_DIR (install-detect-elisp-directory PREFIX)) (add-to-list 'default-load-path LISP_BASE_DIR) (add-to-list 'load-path LISP_BASE_DIR) (add-to-list 'load-path (expand-file-name "apel" LISP_BASE_DIR)) (add-to-list 'load-path (expand-file-name "flim" LISP_BASE_DIR)) (add-to-list 'load-path (expand-file-name ".")) (defvar ELSERV_PREFIX "elserv") (defvar EXEC_DIR (expand-file-name "bin" PREFIX)) (defvar EXECS '("elservd")) (defvar LISP_DIR (expand-file-name ELSERV_PREFIX LISP_BASE_DIR)) (defvar EXEC_SRC_DIR ".") (defvar ICON_SRC_DIR "./icons") (defvar ICON_DIR nil) (defvar PACKAGE_DIR (if (boundp 'early-packages) (let ((dirs (append (if early-package-load-path early-packages) (if late-package-load-path late-packages) (if last-package-load-path last-packages))) dir) (while (not (file-exists-p (setq dir (car dirs)))) (setq dirs (cdr dirs))) dir))) ;;; functions. (defun config-icon (&optional packagedir) "Examine icon directory." (let ((icon-dir (car command-line-args-left))) (setq ICON_DIR (if (string= icon-dir "NONE") (if packagedir (expand-file-name "etc/elserv" packagedir) (expand-file-name "elserv/icons" data-directory)) icon-dir))) (setq command-line-args-left (cdr command-line-args-left))) (defun config-ruby () (unless (file-exists-p (expand-file-name "elservd" EXEC_SRC_DIR)) (let ((path (exec-installed-p "ruby"))) (unless path (error "Please install ruby first.")) (with-temp-buffer (insert-file-contents (expand-file-name "elservd.in" EXEC_SRC_DIR)) (goto-char (point-min)) (if (search-forward "@ruby@") (replace-match path)) (write-region (point-min) (point-max) (expand-file-name "elservd" EXEC_SRC_DIR) nil 'no-msg) (set-file-modes (expand-file-name "elservd" EXEC_SRC_DIR) (+ (* 64 7)(* 8 5) 5)) ; 0755 (princ "elservd is created."))))) (defun config-elserv (&optional silent) (let (prefix lisp-dir exec-dir) (config-ruby) (and (setq prefix (car command-line-args-left)) (or (string-equal "NONE" prefix) (setq PREFIX prefix))) (setq command-line-args-left (cdr command-line-args-left)) (and (setq lisp-dir (car command-line-args-left)) (or (string-equal "NONE" lisp-dir) (setq LISP_BASE_DIR lisp-dir))) (setq command-line-args-left (cdr command-line-args-left)) (and (setq exec-dir (car command-line-args-left)) (or (string-equal "NONE" exec-dir) (setq EXEC_DIR exec-dir))) (setq command-line-args-left (cdr command-line-args-left))) (config-icon) (load-file "ELSERV-CFG") (load-file "ELSERV-ELS") (unless silent (princ "\n") (princ (format "LISP_DIR=%s\nEXEC_DIR=%s\n" LISP_DIR EXEC_DIR)) (if ICON_DIR (princ (format "ICON_DIR=%s\n" ICON_DIR))))) (defun compile-elserv () (config-elserv) (compile-elisp-modules elserv-modules-to-compile ".")) (defun install-elserv () (config-elserv 'silent) (install-elisp-modules elserv-modules "." LISP_DIR) (install-files (directory-files ICON_SRC_DIR nil "\\.\\(gif\\|png\\)$") ICON_SRC_DIR ICON_DIR nil t) (install-files EXECS EXEC_SRC_DIR EXEC_DIR nil t)) (defun config-elserv-package () (let (package-dir exec-dir) (config-ruby) (and (setq package-dir (car command-line-args-left)) (or (string= "NONE" package-dir) (setq PACKAGE_DIR package-dir))) (setq command-line-args-left (cdr command-line-args-left)) (config-icon package-dir) (load-file "ELSERV-CFG") (load-file "ELSERV-ELS") (princ "\n") (princ (format "PACKAGE_DIR=%s\n" PACKAGE_DIR)))) (defun compile-elserv-package () (config-elserv-package) (setq autoload-package-name "elserv") (add-to-list 'command-line-args-left ".") (batch-update-directory) (add-to-list 'command-line-args-left ".") (Custom-make-dependencies) (compile-elisp-modules (append elserv-modules-to-compile '(auto-autoloads custom-load)) ".")) (defun install-elserv-package () (config-elserv-package) (install-elisp-modules (append elserv-modules '(auto-autoloads custom-load)) "./" (expand-file-name ELSERV_PREFIX (expand-file-name "lisp" PACKAGE_DIR))) (install-files (directory-files ICON_SRC_DIR nil "\\.\\(gif\\|png\\)$") ICON_SRC_DIR (expand-file-name ELSERV_PREFIX (expand-file-name "etc" PACKAGE_DIR)) nil t) (install-files EXECS EXEC_SRC_DIR (expand-file-name ELSERV_PREFIX (expand-file-name "etc" PACKAGE_DIR)) nil t)) ;;; ELSERV-MK ends here elserv-0.4.0+0.20011203cvs/Makefile0100644000175000017500000000135107325235720014311 0ustar bg66bg66# # Makefile for Elserv. # PACKAGE = elserv RM = /bin/rm -f CP = /bin/cp -p EMACS = emacs XEMACS = xemacs FLAGS = -batch -q -no-site-file -l ELSERV-MK PREFIX = NONE LISP_DIR = NONE PACKAGE_DIR = NONE EXEC_DIR = NONE ICON_DIR = NONE GOMI = *.elc auto-autoloads.el custom-load.el elservd elc: $(EMACS) $(FLAGS) -f compile-elserv \ $(PREFIX) $(LISP_DIR) $(EXEC_DIR) $(ICON_DIR) install-1: elc $(EMACS) $(FLAGS) -f install-elserv \ $(PREFIX) $(LISP_DIR) $(EXEC_DIR) $(ICON_DIR) install: install-1 package: $(XEMACS) $(FLAGS) -f compile-elserv-package \ $(PACKAGE_DIR) $(EXEC_DIR) install-package-1: package $(XEMACS) $(FLAGS) -f install-elserv-package $(PACKAGE_DIR) install-package: install-package-1 clean: -$(RM) $(GOMI) elserv-0.4.0+0.20011203cvs/README.ja0100644000175000017500000000524407325534035014130 0ustar bg66bg66 Elserv -- Yet Another HTTP Server on Emacsen Elserv $B$O(B Emacs $B>e$G>oCs$7$FF0$/(B HTTP $B%5!<%P$G$9!#(B Emacs $B<+?H$K$O%5!<%P$N5!G=$,$"$j$^$;$s$N$G!"@lMQ$N%5!<%P%W%m%;%9(B (ruby $B%9%/%j%W%H(B)$B$r%P%C%/%(%s%I$GN)$A>e$2!"$=$N%W%m%;%9$HDL?.$9$k$3$H$K(B $B$h$C$F%5!<%P5!G=$re$2$i$l$k(B (Emacs $B$N%3%^%s%I$rl9g$O(B `make install-package' $B$re$,$j$^$9!#(B $B%G%U%)%k%H$N$^$^$@$H%]!<%HHV9f$O(B 8000 $BHV$H$J$j$^$9!#(B $B$=$N$^$^$G$O$[$H$s$I%3%s%F%s%D$,$"$j$^$;$s$N$G!"(B $B4X?t(B elserv-publish $B$r;H$C$F%3%s%F%s%D$rEPO?$7$F$/$@$5$$!#(B es- $B$G;O$^$k%U%!%$%k$KDj5A$5$l$?%"%W%j%1!<%7%g%s$O!"(B $B4X?t(B elserv-package-publish $B$GEPO?$G$-$^$9!#(B $BNc$($P!"(Bes-wiki.el $B$KDj5A$5$l$?(B wiki $B%5!<%P$r(B /wiki $B$KEPO?$9$k$K$O(B $B0J2<$rC$9$H(B $B%5!<%P%W%m%;%9$,=*N;$7$^$9!#(B "*Log of elserv*..." $B$H$$$&%P%C%U%!$K%"%/%;%9%m%0$,;D$j$^$9!#(B $B%"%W%j%1!<%7%g%s!'(B es-demo.el: $B%G%bMQ$N%5%s%W%k%5!<%P$G$9!#(B es-wiki.el: emacs-wiki $B$r;H$C$?(B Wiki $B%5!<%P$G$9!#(B es-mhc.el: MHC $B$r;H$C$?%9%1%8%e!<%k%5!<%P$G$9!#(B es-monitor.el: publish $B$5$l$F$$$k%3%s%F%s%D$N0lMw$rI=<($7$^$9!#(B $B%G%U%)%k%H$G(B /monitor $B$K(B publish $B$5$l$F$$$^$9!#(B remote.el: web $B%V%i%&%67PM3$G(B Emacs $B$rA`:n$9$k$?$a$N%5!<%P$G$9!#(B web-custom.el: web $B%V%i%&%67PM3$G(B Emacs $B$r%+%9%?%^%$%:$9$k$?$a$N%5!<%P$G$9!#(B $B@-G=I>2A!'(B http_load $B$K$h$kI>2A(B % http_load -parallel 10 -seconds 2 elserv-test 171 fetches, 10 max parallel, 191349 bytes, in 2.00573 seconds 1119 mean bytes/connection 85.2557 fetches/sec, 95401.1 bytes/sec msecs/connect: 0.203205 mean, 1.205 max, 0.082 min msecs/first-response: 77.3926 mean, 133.693 max, 27.229 min (localhost $B$+$i(B localhost $B$KBP$9$k%"%/%;%9!#(B elserv-demo $B$N%H%C%W%Z!<%8$rBP>]$H$7$?!#(B $B4D6-!'(BCeleron 400MHz, FreeBSD 3.5.1, Emacs 21) -- Yuuichi Teranishi elserv-0.4.0+0.20011203cvs/elserv-autoindex.el0100644000175000017500000001511207324771125016474 0ustar bg66bg66;;; elserv-autoindex.el -- Handles the on-the-fly html index generation ;; Copyright (C) 2001 OHASHI Akira ;; Author: OHASHI Akira ;; Keywords: HTTP ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Code: (eval-when-compile (require 'cl)) (require 'elserv) (defvar elserv-autoindex-http-header " Index of %s

Index of %s

\" Name                     Last modified       Size  Description

\n")

(defvar elserv-autoindex-list-format
  "\"[%s]\" %s %s%s  \n")

(defvar elserv-autoindex-http-footer
  "
%s Server at %s Port %s
\n") (defvar elserv-autoindex-ignore-list '("^\\." "~$" "#$" "^HEADER" "^README" "RCS" "CVS" ",v$" ",t$")) (defvar elserv-autoindex-icon-alist '(("\\.css$" . (:label "TXT" :icon "text.gif")) ("\\.html?$" . (:label "TXT" :icon "text.gif")) ("\\.txt$" . (:label "TXT" :icon "text.gif")) ("\\.jpe?g$" . (:label "IMG" :icon "image2.gif")) ("\\.gif$" . (:label "IMG" :icon "image2.gif")) ("\\.png$" . (:label "IMG" :icon "image2.gif")) ("\\.tiff?$" . (:label "IMG" :icon "image2.gif")) ("\\.x[bp]m$" . (:label "IMG" :icon "image2.gif")) ("\\.gz$" . (:label " " :icon "compressed.gif")) ("\\.z$" . (:label "CMP" :icon "compressed.gif")) ("\\.e?ps$" . (:label " " :icon "a.gif")) ("\\.tex$" . (:label " " :icon "tex.gif")) ("\\.dvi$" . (:label " " :icon "dvi.gif")) ("\\.pdf$" . (:label " " :icon "layout.gif")) ("\\.tar$" . (:label " " :icon "tar.gif")) ("\\.zip$" . (:label " " :icon "compressed.gif")) ("\\.lzh$" . (:label " " :icon "compressed.gif")) ("\\.mp[23]$" . (:label "SND" :icon "sound2.gif")) ("\\.midi?$" . (:label "SND" :icon "sound2.gif")) ("\\.wav$" . (:label "SND" :icon "sound2.gif")) ("\\.au$" . (:label "SND" :icon "sound2.gif")) ("\\.ram$" . (:label "SND" :icon "sound2.gif")) ("\\.r[am]$" . (:label "SND" :icon "sound2.gif")) ("\\.mpe?g$" . (:label "VID" :icon "movie.gif")) ("\\.qt$" . (:label "VID" :icon "movie.gif")) ("\\.mov$" . (:label "VID" :icon "movie.gif")) ("\\.avi$" . (:label "VID" :icon "movie.gif")) ("^core$" . (:label " " :icon "bomb.gif")) ("\\.c$" . (:label " " :icon "c.gif")) ("\\.p[ly]$" . (:label " " :icon "p.gif")) ("\\.sh$" . (:label " " :icon "script.gif")) ("\\.bin$" . (:label " " :icon "binary.gif")) ("\\.exe$" . (:label " " :icon "binary.gif")))) (defun elserv-autoindex (result host path directory) "Handles the on-the-fly html index generation." (let (port files string) (if (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" host) (string-match "^\\([^:]+\\):?\\([0-9]*\\)" host)) (progn (setq port (match-string 2 host)) (setq host (match-string 1 host))) (setq port "80")) (unless (string= path "/") (setq path (substring path 0 (string-match "/$" path))) (setq string (format elserv-autoindex-list-format (concat elserv-icon-publish-path "/back.gif") "DIR" ".." "Parent Directory" (format "%25s" (elserv-autoindex-get-attr (expand-file-name ".." directory) 'lastmodified)) (format "%7s" "-")))) (setq files (directory-files directory nil "^\\([^.].+\\|\\.[^.].+\\|\\.\\..+\\)$")) (dolist (list elserv-autoindex-ignore-list) (dolist (file files) (if (string-match list file) (setq files (delete file files))))) (dolist (filename files) (let* ((realfile (expand-file-name filename directory)) (icon (elserv-autoindex-get-attr realfile 'icon)) (label (elserv-autoindex-get-attr realfile 'label)) (lastmodified (elserv-autoindex-get-attr realfile 'lastmodified)) (size (elserv-autoindex-get-attr realfile 'size))) (setq string (concat string (format elserv-autoindex-list-format icon label filename filename (format (concat "%" (number-to-string (- 41 (length filename))) "s") lastmodified) (format "%7s" size)))))) (elserv-set-result-code result 'elserv-ok) (elserv-set-result-header result `(content-type "text/html")) (elserv-set-result-body result (concat (format elserv-autoindex-http-header path path elserv-icon-publish-path) string (format elserv-autoindex-http-footer (elserv-version) host port))) result)) (defun elserv-autoindex-get-attr (realfile type) "Return TYPE attribute of REALFILE." (cond ((eq type 'icon) (concat elserv-icon-publish-path "/" (elserv-autoindex-get-icon realfile ':icon))) ((eq type 'label) (elserv-autoindex-get-icon realfile ':label)) ((eq type 'lastmodified) (let ((system-time-locale "C")) (format-time-string "%d-%b-%Y %R" (nth 5 (file-attributes realfile))))) ((eq type 'size) (if (file-directory-p realfile) "-" (let ((size (nth 7 (file-attributes realfile)))) (cond ((<= 1 (/ size 1048576)) (format "%3.1fM" (/ size 1048576.0))) ((<= 1 (/ size 1024)) (format "%4.0fk" (/ size 1024.0))) (t size))))))) (defun elserv-autoindex-get-icon (filename type) "Return icon's filename or lable for FILENAME." (let ((alist (or (if (file-directory-p filename) '("directory" . (:label "DIR" :icon "folder.gif")) (let ((file (file-name-nondirectory filename))) (catch 'found (dolist (list elserv-autoindex-icon-alist) (if (string-match (car list) file) (throw 'found list)))))) '("unknown" . (:label " " :icon "unknown.gif"))))) (plist-get (cdr alist) type))) (provide 'elserv-autoindex) ;;; elserv-autoindex.el ends here elserv-0.4.0+0.20011203cvs/elserv-negotiation.el0100644000175000017500000000730307331200502016777 0ustar bg66bg66;;; elserv-negotiation.el -- Handles the content negotiation. ;; Copyright (C) 2001 OHASHI Akira ;; Author: OHASHI Akira ;; Keywords: HTTP ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Code: (eval-when-compile (require 'cl)) (require 'elserv) (defvar elserv-negotiation-http-header " 406 Not Acceptable

Not Acceptable

An appropriate representation of the requested resource %s could not be found on this server.

Available variants:

    \n") (defvar elserv-negotiation-list-format "
  • %s , %s, language %s\n") (defvar elserv-negotiation-http-footer "
%s Server at %s Port %s
\n") (defvar elserv-negotiation-language-list '("en" "ja" "da" "nl" "et" "fr" "de" "el" "it" "pt" "ltz" "ca" "es" "sv")) (defun elserv-negotiation (filename language) "Return a filename which matches to FILENAME and LANGUAGE exists." (let (realfile) (if language (let ((langs (elserv-negotiation-language language))) (setq realfile (catch 'done (dolist (lang langs) (if (file-readable-p (setq realfile (concat filename "." lang))) (throw 'done realfile))))))) (if (stringp realfile) realfile (if (file-readable-p filename) filename (let ((files (directory-files (file-name-directory filename) nil (concat "^" (file-name-nondirectory filename) "\\.[A-Za-z]+$")))) (dolist (file files) (catch 'found (dolist (list elserv-negotiation-language-list) (if (string-match (concat "\\." list "$") file) (throw 'found t))) (setq files (delete file files)))) files))))) (defun elserv-negotiation-language (string) "Parse Accept-Language field body and return language candidate list." (let (candidates) (while (string-match "^\\([A-Za-z-]+\\)\\(\\(; *q=[0-9.]+\\)?, *\\)?" string) (setq candidates (cons (substring string (match-beginning 1)(match-end 1)) candidates)) (setq string (substring string (match-end 0)))) (nreverse candidates))) (defun elserv-negotiation-make-result (result host path files) "Make a result of content negotioation." (let (port string) (if (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" host) (string-match "^\\([^:]+\\):?\\([0-9]*\\)" host)) (progn (setq port (match-string 2 host)) (setq host (match-string 1 host))) (setq port "80")) (dolist (file files) (setq string (concat string (format elserv-negotiation-list-format file file (elserv-mime-type file) (file-name-extension file))))) (elserv-set-result-code result 'elserv-ok) (elserv-set-result-header result `(content-type "text/html")) (elserv-set-result-body result (concat (format elserv-negotiation-http-header path) string (format elserv-negotiation-http-footer (elserv-version) host port))) result)) (provide 'elserv-negotiation) ;;; elserv-negotiation.el ends here elserv-0.4.0+0.20011203cvs/elserv-xmlrpc.el0100644000175000017500000001636207331206054016001 0ustar bg66bg66;;; elserv-xmlrpc.el -- Elserv interface for XML-RPC. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP, XML-RPC ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; ;; Example: ;; ;; (defun hello (p) ;; (format "Hello, %s." p)) ;; To register above function hello as "example.hello", evaluate following. ;; (elserv-xmlrpc-register "example.hello" 'hello ;; '(("string" "string")) "ISO-2022-JP") ;; 1st argument is the method name to register. ;; 2nd argument is the function that corresponds. ;; 3rd argument is the signature for the method. ;; 4th argument is the encoding for the returned xml(optional). ;;; Code: (require 'elserv) (require 'xml-rpc) (require 'mcharset) (eval-when-compile (require 'cl)) (put 'elserv-xmlrpc-exception 'error-conditions '(elserv-xmlrpc-exception error)) (defmacro elserv-xmlrpc-define-fault (name code string) "Define fault code with NAME, CODE, and STRING." `(progn (put ',name 'error-conditions '(,name elserv-xmlrpc-exception error)) (put ',name 'elserv-xmlrpc-code ,code) (put ',name 'elserv-xmlrpc-string ,string))) (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-method-missing 1 "Method missing.") (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-uncaught-exception 2 "Uncaught exception.") (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-wrong-parameter 3 "Wrong parameter.") (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-wrong-number-params 4 "Wrong number of parameters.") (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-missing-method-name 5 "Missing method name.") (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-recursive-call 6 "Recursive call.") (elserv-xmlrpc-define-fault elserv-xmlrpc-fault-expected-struct 8 "Struct expected.") (put 'with-elserv-xmlrpc-fault-handler 'edebug-form-spec '(body)) (defmacro with-elserv-xmlrpc-fault-handler (&rest forms) "Evaluate FORMS like progn with elserv xmlrpc fault handler." `(condition-case why (progn ,@forms) (wrong-number-of-arguments (elserv-xmlrpc-exception 'elserv-xmlrpc-fault-wrong-number-params)) (wrong-type-argument (elserv-xmlrpc-exception 'elserv-xmlrpc-fault-wrong-parameter)) (void-function (elserv-xmlrpc-exception 'elserv-xmlrpc-fault-method-missing)) (elserv-xmlrpc-exception (elserv-xmlrpc-exception (car why))) (error (elserv-xmlrpc-exception 'elserv-xmlrpc-uncaught-exception (format "Uncaught exception: %s\n" why))))) (defun elserv-xmlrpc-exception (why &optional msg) "Make a fault response from WHY. If optional MSG is specified, it is used as response body." `((methodResponse nil (fault nil ,(car (xml-rpc-value-to-xml-list `(("faultCode" . ,(get why 'elserv-xmlrpc-code)) ("faultString" . ,(or msg (get why 'elserv-xmlrpc-string)))))))))) (defun elserv-xmlrpc-register (method-name function signature &optional encoding) "Add METHOD-NAME entry for FUNCTION with SIGNATURE. Optional ENCODING specifies the encoding of the response." (put 'elserv-xmlrpc-method (intern method-name) function) (put 'elserv-xmlrpc-method-signature (intern method-name) signature) (when encoding (put 'elserv-xmlrpc-method-encoding (intern method-name) encoding))) (defun elserv-xmlrpc-unregister (method-name) "Remove METHOD-NAME entry." (put 'elserv-xmlrpc-method (intern method-name) nil) (put 'elserv-xmlrpc-method-signature (intern method-name) nil) (when (get 'elserv-xmlrpc-method-encoding (intern method-name)) (put 'elserv-xmlrpc-method-encoding (intern method-name) nil))) (defun elserv-xmlrpc-get-function (method-name) "Get fuction for METHOD-NAME." (get 'elserv-xmlrpc-method (intern method-name))) (defun elserv-xmlrpc-get-signature (method-name) "Get signature for METHOD-NAME." (get 'elserv-xmlrpc-method-signature (intern method-name))) (defun elserv-xmlrpc-get-encoding (method-name) "Get encoding for METHOD-NAME." (get 'elserv-xmlrpc-method-encoding (intern method-name))) (defun elserv-xmlrpc-get-method-help (method-name) "Get documentation of METHOD-NAME." (let ((func (get 'elserv-xmlrpc-method (intern method-name)))) (documentation func))) (defun elserv-xmlrpc-list-methods () "Return List of method-names" (let ((plist (symbol-plist 'elserv-xmlrpc-method)) methods) (while plist (if (cadr plist) (setq methods (cons (symbol-name (car plist)) methods))) (setq plist (cddr plist))) methods)) (defun elserv-xmlrpc-process-request (request) (let ((xml (car (with-temp-buffer (insert request) (xml-parse-region (point-min) (point-max))))) method params) (setq method (car (xml-node-children (assq 'methodName (xml-node-children xml))))) (setq params (xml-node-children (assq 'params (xml-node-children xml))) params (unless (equal params '("")) ; empty params (mapcar (lambda (node) (xml-rpc-xml-list-to-value (xml-node-children node))) params))) (elserv-xmlrpc-method-call method params))) (defun elserv-xmlrpc-method-call (method params) "XML-RPC method call for METHOD and PARAMS." (let ((encoding (elserv-xmlrpc-get-encoding method))) (concat "" (xml-rpc-xml-to-string (car (with-elserv-xmlrpc-fault-handler (unless method (signal 'elserv-xmlrpc-fault-missing-method-name nil)) (let ((func (elserv-xmlrpc-get-function method))) (if (and func (functionp func)) `((methodResponse nil (params nil (param nil ,(car (xml-rpc-value-to-xml-list (apply func params))))))) (signal 'elserv-xmlrpc-fault-method-missing nil))))) (if encoding (mime-charset-to-coding-system encoding)))))) (defun elserv-xmlrpc-register-defaults () "Register default methods." ;; standard methods. (elserv-xmlrpc-register "system.listMethods" 'elserv-xmlrpc-list-methods '(("array"))) (elserv-xmlrpc-register "system.methodSignature" 'elserv-xmlrpc-get-signature '(("array" "string"))) (elserv-xmlrpc-register "system.methodHelp" 'elserv-xmlrpc-get-method-help '(("string" "string"))) ;; search method. (elserv-xmlrpc-register "system.search" 'elserv-search '(("array" "string")))) (require 'product) (product-provide (provide 'elserv-xmlrpc) (require 'elserv)) ;;; elserv-xmlrpc.el ends here elserv-0.4.0+0.20011203cvs/elserv.el0100644000175000017500000012561407331200502014467 0ustar bg66bg66;;; elserv.el -- Yet another HTTP server on Emacsen ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; ;; API for server handling ;; elserv-start ;; elserv-find-process ;; elserv-stop ;; elserv-publish ;; elserv-unpublish ;; API for content making ;; elserv-make-result ;; elserv-make-redirect ;; Example: ;; ;; (require 'elserv) ;; (elserv-start 8080) ;; (elserv-publish (elserv-find-process 8080) "/" ;; :string "Hello World." ;; :content-type "text/plain") ;; ;; or write following lines in your .emacs. ;; ;; (autoload elserv-start "elserv" nil t) ;; (add-hook 'elserv-start-hook ;; '(lambda () ;; (elserv-publish (elserv-find-process) "/" ;; :string "Hello World." ;; :content-type "text/plain"))) ;;; History: ;; ;; Part of the codes are originally in an HTTP server embedded in Emacs ;; available from . ;;; Code: (require 'product) (require 'pces) (require 'poem) (require 'std11) (eval-when-compile (require 'cl) (require 'static)) (eval-and-compile (autoload 'elserv-autoindex "elserv-autoindex") (autoload 'elserv-xmlrpc-register "elserv-xmlrpc") (autoload 'elserv-negotiation "elserv-negotiation") (autoload 'elserv-negotiation-make-result "elserv-negotiation")) (product-provide 'elserv (product-define "Elserv" nil '(0 4 0) "Never Surrender")) (defgroup elserv nil "Elserv -- Yet another HTTP server on Emacsen." :group 'hypermedia) (defcustom elserv-default-server-name (system-name) "*Default server name for Elserv." :type 'string :group 'elserv) (defcustom elserv-default-port 8000 "*Default port number for Elserv." :type 'integer :group 'elserv) (defcustom elserv-program-name nil "*If non-nil, it is invoked as a command. `elserv-daemon-name' is passed as first argument." :type '(choice (symbol :tag "Direct" nil) (string :tag "Program Name")) :group 'elserv) (defcustom elserv-daemon-name (if (fboundp 'locate-data-directory) (expand-file-name "elservd" (locate-data-directory "elserv")) "elservd") "*Program name for Elserv daemon process." :type 'string :group 'elserv) (defcustom elserv-publish-hash-length 31 "*Length of publish hash." :type 'integer :group 'elserv) (defcustom elserv-debug nil "*If non-nil, request string is inserted to the debug buffer." :type 'boolean :group 'elserv) (defcustom elserv-directory-index-file "index.html" "*Index file name for the directory." :type 'string :group 'elserv) (defcustom elserv-directory-autoindex t "*If non-nil and directory has no index file, generate html index in the directory." :type 'boolean :group 'elserv) (defcustom elserv-search-default-make-index t "*If non-nil, search index is created in `elserv-publish'." :type 'boolean :group 'elserv) (defcustom elserv-use-negotiation t "*If non-nil, use content negotiation." :type 'boolean :group 'eliserv) (defcustom elserv-keep-alive t "*Non-nil enable persistent connections. \(more than one request per connection\)." :type 'boolean :group 'elserv) (defcustom elserv-max-keep-alive-requests 100 "*The maximum number of requests to allow during a persistent connection. Set to nil to allow an unlimited amount. We recommend you leave this number high, for maximum performance." :type 'integer :group 'elserv) (defcustom elserv-keep-alive-timeout 15 "*Number of seconds to wait for the next request on the same connection." :type 'integer :group 'elserv) (defcustom elserv-identity-check nil "*Non-nil enables RFC1413-compliant logging. \(logging of the remote user name for each connection\)" :type 'boolean :group 'elserv) (defcustom elserv-max-clients 20 "*Non-nil limits the number of clients who can simultaneously connect. If this limit is ever reached, clients will be LOCKED OUT." :type 'integer :group 'elserv) (defcustom elserv-access-log-file nil "*If file name is specified, access log is saved to the file." :type 'file :group 'elserv) (defcustom elserv-access-log-max-size 50000 "*Max size of access log file." :type 'integer :group 'elserv) (defcustom elserv-icon-path (if (fboundp 'locate-data-directory) (locate-data-directory "elserv") (let ((icons (expand-file-name "elserv/icons/" data-directory))) (if (file-directory-p icons) icons))) "*Icon directory path." :type 'directory :group 'elserv) (defcustom elserv-icon-publish-path "/icons" "*Path to publish an icon directory specified by `elserv-icon-path'." :type 'string :group 'elserv) (defcustom elserv-server-admin-full-name (user-full-name) "*Full name of the server admin." :type 'string :group 'elserv) (defcustom elserv-server-admin-mail-address user-mail-address "*E-mail address of the server admin." :type 'string :group 'elserv) (defconst elserv-url-unreserved-chars '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?$ ?- ?_ ?. ?! ?~ ?* ?' ?( ?) ?,)) (defconst elserv-http-version "HTTP/1.1") (defconst elserv-server-eol "\r\n" "The end-of-line string sent from the server.") (defconst elserv-client-eor "\r\n\r\n" "The end-of-request string sent from the elservd.") (defvar elserv-buffer-publish-hash nil) (make-variable-buffer-local 'elserv-buffer-publish-hash) (defvar elserv-buffer-request-handler nil) (make-variable-buffer-local 'elserv-buffer-request-handler) (defvar elserv-buffer-port nil) (make-variable-buffer-local 'elserv-buffer-port) (defvar elserv-buffer-client-process nil) (make-variable-buffer-local 'elserv-buffer-client-process) (defvar elserv-buffer-client-port nil) (make-variable-buffer-local 'elserv-buffer-client-port) (defvar elserv-buffer-search-index-buffer nil) (make-variable-buffer-local 'elserv-buffer-search-index-buffer) (defvar elserv-mime-types-alist '(("html" . "text/html") ("txt" . "text/plain") ("jpg" . "image/jpeg") ("jpeg" . "image/jpeg") ("gif" . "image/gif") ("png" . "image/png") ("tif" . "image/tiff") ("tiff" . "image/tiff") ("css" . "text/css") ("gz" . "application/octet-stream") ("ps" . "application/postscript") ("pdf" . "application/pdf") ("eps" . "application/postscript") ("tar" . "application/x-tar") ("rpm" . "application/x-rpm") ("zip" . "application/zip") ("mp3" . "audio/mpeg") ("mp2" . "audio/mpeg") ("mid" . "audio/midi") ("midi" . "audio/midi") ("wav" . "audio/x-wav") ("au" . "audio/basic") ("ram" . "audio/pn-realaudio") ("ra" . "audio/x-realaudio") ("mpg" . "video/mpeg") ("mpeg" . "video/mpeg") ("qt" . "video/quicktime") ("mov" . "video/quicktime") ("avi" . "video/x-msvideo")) "Alist of (SUFFIX .CONTENT-TYPE).") (defsubst elserv-bytes (string) "Return the byte length of the STRING." (length (string-as-unibyte string))) (defun elserv-mime-type (filename) "Return content-type for FILENAME." (or (cdr (assoc (file-name-extension filename) elserv-mime-types-alist)) "text/plain")) (put 'elserv-exception 'error-conditions '(elserv-exception error)) (defmacro elserv-define-status-code (name code msg) "Define status code with NAME, CODE, and MSG." `(progn (put ',name 'error-conditions '(,name elserv-exception error)) (put ',name 'elserv-code ,code) (put ',name 'elserv-msg ,msg))) (elserv-define-status-code elserv-ok 200 "OK") (elserv-define-status-code elserv-moved-permanently 301 "Moved permanently") (elserv-define-status-code elserv-found 302 "Found") (elserv-define-status-code elserv-see-other 303 "See Other") (elserv-define-status-code elserv-not-modified 304 "Not Modified") (elserv-define-status-code elserv-bad-request 400 "Bad request") (elserv-define-status-code elserv-unauthorized 401 "Unauthorized") (elserv-define-status-code elserv-forbidden 403 "Forbidden") (elserv-define-status-code elserv-file-not-found 404 "Not found") (elserv-define-status-code elserv-method-not-allowed 405 "Method not allowed") (elserv-define-status-code elserv-internal-error 500 "Internal server error") (elserv-define-status-code elserv-unimplemented 501 "Not implemented") (elserv-define-status-code elserv-unavailable 503 "Service unavailable") ;;; Result (defmacro elserv-make-result (&optional code header body user content-length) "Make a result structure. CODE is the status code. HEADER is the plist for header structure. BODY is the body string. USER is the user who is authenticated. CONTENT-LENGTH is the length of the content." `(vector ,code ,header ,body ,user ,content-length)) (defmacro elserv-result-code (result) "Return code of RESULT." `(aref ,result 0)) (defmacro elserv-set-result-code (result code) "Set code of RESULT as CODE." `(aset ,result 0 ,code)) (defmacro elserv-result-header (result) "Return header of RESULT." `(aref ,result 1)) (defmacro elserv-set-result-header (result header) "Set header of RESULT as HEADER." `(aset ,result 1 ,header)) (defmacro elserv-result-body (result) "Return body of RESULT." `(aref ,result 2)) (defmacro elserv-set-result-body (result body) "Set body of RESULT as BODY." `(aset ,result 2 ,body)) (defmacro elserv-result-user (result) "Return user of RESULT." `(aref ,result 3)) (defmacro elserv-set-result-user (result user) "Set user of RESULT as USER." `(aset ,result 3 ,user)) (defmacro elserv-result-content-length (result) "Return content-length of RESULT." `(aref ,result 4)) (defmacro elserv-set-result-content-length (result content-length) "Set content-length of RESULT as CONTENT-LENGTH." `(aset ,result 4 ,content-length)) ;;; Error (defun elserv-error (why &optional msg) "Make a error response from WHY. If optional MSG is specified, it is used as response body." (elserv-make-result (car why) '(content-type "text/html") (concat "Error\n" "

" (get (car why) 'elserv-msg) "

\n

" (or msg (cdr why)) "\n\n"))) (put 'with-elserv-error-handler 'edebug-form-spec '(body)) (defmacro with-elserv-error-handler (&rest forms) "Evaluate FORMS like progn with elserv error handler." `(condition-case why (progn ,@forms) (elserv-exception (elserv-error why)) (error (elserv-error (cons 'elserv-internal-error nil) (format "Emacs Lisp error: %s\n" why))))) (defun elserv-host-member (host list) "Return t if HOST is matched to any of the regexp in the LIST." (let ((case-fold-search t) match) (while list (if (or (string-match (car list) (nth 0 host)) (string-match (car list) (nth 1 host))) (setq match t list nil) (setq list (cdr list)))) match)) (defun elserv-make-predicate-from-plist (plist) "Make a check predicate from PLIST." (let (second pred) (while plist (when (eq (car plist) :allow) (setq pred (list 'and (list 'elserv-host-member 'host (append (list 'list) (cadr plist))) (if (setq second (cadr (memq :deny (cdr plist)))) (list 'not (list 'elserv-host-member 'host (append (list 'list) second))) t))) (setq plist nil)) (when (eq (car plist) :deny) (setq pred (list 'or (list 'not (list 'elserv-host-member 'host (append (list 'list (cadr plist))))) (if (setq second (cadr (memq :deny (cdr plist)))) (list 'elserv-host-member 'host (append (list 'list second)))))) (setq plist nil)) (setq plist (cdr plist))) (or pred t))) (defun elserv-make-unauthorized-basic (request realm) "Make unauthorized RESULT for REQUEST. Basic authorization response with REALM is created." (let ((result (elserv-make-result))) (elserv-set-result-code result 'elserv-unauthorized) (elserv-set-result-header result `(www-authenticate ,(concat "Basic realm=\"" realm "\"") content-type "text/html")) (elserv-set-result-body result (concat "Authorization required

Authorization Required

This server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials (e.g., bad password), or your browser doesn't understand how to supply the credentials required.
" (elserv-version) "")) result)) (defun elserv-make-redirect (result where) "Make RESULT as a redirect to new location WHERE." (elserv-set-result-code result 'elserv-moved-permanently) (elserv-set-result-header result (list 'location where 'content-type "text/html" 'uri where)) (elserv-set-result-body result "Moved permanently

Moved permanently

This Page is moved permanently.") result) (defun elserv-version (&optional arg) "Return Elserv version. If it is called interactively, version string is appeared on minibuffer. If ARG is specified, don't display code name." (interactive "P") (let ((product-info (product-string-1 'elserv (not arg)))) (if (interactive-p) (message "%s" product-info) product-info))) ;;; URL decode: original codes are cgi.el (defun elserv-url-hex-char-p (ch) "Return non-nil if CH is hex char." (declare (character ch)) (let ((hexchars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))) (member (upcase ch) hexchars))) (defun elserv-url-decode-string (str) "Decode STR as URL string. It replaces %xx to the corresponding character and + to ' '." (do ((i 0) (len (length str)) (decoded '())) ((>= i len) (concat (nreverse decoded))) (let ((ch (aref str i))) (cond ((eq ?+ ch) (push ?\ decoded) (incf i)) ((and (eq ?% ch) (< (+ i 2) len) (elserv-url-hex-char-p (aref str (+ i 1))) (elserv-url-hex-char-p (aref str (+ i 2)))) (let ((hex (string-to-number (substring str (+ i 1) (+ i 3)) 16))) (push (int-char hex) decoded) (incf i 3))) (t (push ch decoded) (incf i)))))) (defsubst elserv-position (char str) "Find the first occurrence of CHAR in STR." (let ((end (length str)) (i 0) pos) (while (< i end) (if (eq (aref str i) char) (setq pos i i end)) (incf i)) pos)) (defun elserv-url-decode (q) "Parse string Q as URL query. \"foo=x&bar=y+re\" into ((\"foo\" . \"x\") (\"bar\" \. \"y re\")) Substrings are plus-decoded and then URL-decoded." (when q (flet ((split-= (str) (let ((pos (or (elserv-position ?= str) 0))) (cons (elserv-url-decode-string (substring str 0 pos)) (elserv-url-decode-string (substring str (+ pos 1))))))) (mapcar #'split-= (split-string q "&"))))) ;;; Object loading and saving. (defun elserv-load (filename &optional coding) "Load OBJECT from the file specified by FILENAME. File content is decoded with CODING." (if (not (file-readable-p filename)) nil (with-temp-buffer (insert-file-contents-as-binary filename) (when coding (set-buffer-multibyte t) (decode-coding-region (point-min) (point-max) coding)) (ignore-errors (read (current-buffer)))))) (defun elserv-make-directory (path) "Create directory on PATH recursively." (let ((parent (directory-file-name (file-name-directory path)))) (if (null (file-directory-p parent)) (elserv-make-directory parent)) (make-directory path))) (defsubst elserv-save-buffer (filename &optional coding) "Save current buffer to the file specified by FILENAME. Directory of the file is created if it doesn't exist. File content is encoded with CODING." (let ((dir (directory-file-name (file-name-directory filename)))) (if (file-directory-p dir) () ; ok. (unless (file-exists-p dir) (elserv-make-directory dir))) (when coding (encode-coding-region (point-min) (point-max) coding)) (write-region-as-binary (point-min) (point-max) filename nil 'no-msg))) (defun elserv-save (filename object &optional coding) "Save object. FILENAME is the name of the saved file. OBJECT is the object to be saved. Directory of the file is created if it doesn't exist. File content is encoded with CODING before saving." (with-temp-buffer (prin1 object (current-buffer)) (elserv-save-buffer filename coding) object)) ;;; Debug (defvar elserv-debug-buffer nil) (defun elserv-debug (string) "Insert STRING to the debug buffer." (when elserv-debug (if (or (null elserv-debug-buffer) (not (bufferp elserv-debug-buffer)) (not (buffer-live-p elserv-debug-buffer))) (setq elserv-debug-buffer (get-buffer-create "*Debug elserv*"))) (with-current-buffer elserv-debug-buffer (goto-char (point-max)) (insert string)))) (defun elserv-process-filter (process string) "Process filter elserv. PROCESS, STRING are argument for process filter." (elserv-debug string) (when (buffer-live-p (process-buffer process)) (with-current-buffer (process-buffer process) (goto-char (point-max)) (insert string) (goto-char (point-min)) (while (re-search-forward elserv-client-eor nil t) (elserv-process-request process (elserv-parse-request (buffer-substring (point-min) (point)))) (delete-region (point-min) (point)))))) (defsubst elserv-client-start (port process) "Start client process for elservd. PORT is the elservd client port. PROCESS is the server process." (with-current-buffer (get-buffer-create (concat "*elserv client*" (number-to-string (elserv-process-port process)))) (set-buffer-multibyte nil) (open-network-stream-as-binary "_elserv" (current-buffer) "localhost" port))) (defsubst elserv-process-request-internal (request client-process process handler) "Process request. REQUEST, CLIENT-PROCESS, PROCESS, HANDLER are used." (let (result header connection string) (setq result (with-elserv-error-handler (funcall handler process request))) (setq connection (elserv-decide-connection result request)) (setq header (elserv-make-header result request connection)) (setq string (concat (plist-get request 'key) (if (string= connection "close") ";" ":") (number-to-string (+ (elserv-bytes header) ;; redundant process. (if (elserv-result-body result) (elserv-bytes (elserv-result-body result)) 0))) "\r\n")) (process-send-string client-process string) (process-send-string client-process header) (elserv-debug string) (elserv-debug header) (when (elserv-result-body result) (process-send-string client-process (elserv-result-body result)) (elserv-debug (elserv-result-body result)) (elserv-debug "\r\n")) (process-send-string client-process "\r\n") (elserv-log process request result))) (defun elserv-process-request (process request) "Process request string on the current buffer. PROCESS is elserv process. REQUEST is the request plist." ;; current buffer is process buffer. (let ((client-process elserv-buffer-client-process) (handler elserv-buffer-request-handler)) (if elserv-buffer-client-port (progn (unless (memq (process-status elserv-buffer-client-process) '(open run)) (delete-process elserv-buffer-client-process) ;; restart. (setq elserv-buffer-client-process (elserv-client-start elserv-buffer-client-port process) client-process elserv-buffer-client-process)) (with-current-buffer (process-buffer elserv-buffer-client-process) (elserv-process-request-internal request client-process process handler))) ;; Process greeting. (setq elserv-buffer-client-port (string-to-number (plist-get request 'port)) elserv-buffer-client-process (elserv-client-start elserv-buffer-client-port process))))) (defsubst elserv-delete-cr-buffer () "Delete CR from buffer." (save-excursion (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) )) (defun elserv-parse-request (request) "Parse REQUEST string." (with-temp-buffer (set-buffer-multibyte nil) (insert request) (elserv-delete-cr-buffer) (goto-char (point-min)) (let ((regexp (concat "\\(" std11-field-head-regexp "\\)[ \t]*")) name body dest end) (while (re-search-forward regexp nil t) (setq name (downcase (buffer-substring (match-beginning 1)(1- (match-end 1)))) end (match-end 0) name (intern (if (string-match "^elserv-" name) (setq name (substring name (match-end 0))) name)) body (buffer-substring end (std11-field-end))) (if (eq name 'client) (setq body (split-string body))) (when (eq name 'content) (setq name 'body) (setq body (ignore-errors (base64-decode-string body)))) (setq dest (nconc (list name body) dest))) dest))) (defun elserv-decide-connection (result request) "Decide connection type by RESULT and REQUEST." (if (and elserv-keep-alive (string-match "keep-alive" (or (plist-get request 'connection) "")) (eq (get (elserv-result-code result) 'elserv-code) 200)) "keep-alive" "close")) (defun elserv-make-header (result request connection) "Make an HTTP header string from RESULT, REQUEST, and CONNECTION." (concat elserv-http-version " " (number-to-string (get (elserv-result-code result) 'elserv-code)) " " (get (elserv-result-code result) 'elserv-msg) "\r\nServer: " (elserv-version 'simple) "\r\nAccept-Ranges: none" "\r\nDate: " (let ((system-time-locale "C")) (format-time-string "%a, %e %b %Y %T %Z")) "\r\nConnection: " connection (if (string= connection "keep-alive") (concat "\r\nKeep-Alive: timeout=" (number-to-string elserv-keep-alive-timeout) ", max=" (number-to-string elserv-max-keep-alive-requests))) "\r\n" (let ((header (elserv-result-header result)) str) (while header (setq str (concat str (capitalize (symbol-name (nth 0 header))) ": " (nth 1 header) "\r\n")) (setq header (nthcdr 2 header))) str) "Content-Length: " (number-to-string (+ 2 (or (elserv-result-content-length result) (if (elserv-result-body result) (elserv-bytes (elserv-result-body result)) 0)))) "\r\n" "MIME-Version: 1.0\r\n\r\n")) (defun elserv-process-sentinel (process string) "A sentinel for elserv process. PROCESS, STRING are arguments for sentinel." (elserv-debug string) (delete-process process)) ;;; Commands ;;;###autoload (defun elserv-start (&optional port) "Start elserv server process. Optional PORT is port number for the server process. If PORT is not specified, `elserv-default-port' is used. Return server process object." (interactive) (let (process args) (setq port (or port elserv-default-port)) (setq args (list (number-to-string port) (if elserv-identity-check "log" "nolog") (number-to-string (or elserv-max-clients 0)) (number-to-string (or elserv-max-keep-alive-requests 0)) (number-to-string (or elserv-keep-alive-timeout 0)))) (if elserv-program-name (setq args (cons elserv-daemon-name args))) (setq process (as-binary-process (apply 'start-process "elserv" (get-buffer-create (concat "*elserv*" (number-to-string port))) (or elserv-program-name elserv-daemon-name) args))) (with-current-buffer (process-buffer process) (set-buffer-multibyte nil) (erase-buffer) (setq elserv-buffer-search-index-buffer (elserv-search-initialize)) (setq elserv-buffer-request-handler 'elserv-request-handler) (setq elserv-buffer-publish-hash (make-vector elserv-publish-hash-length 0)) (setq elserv-buffer-port port)) (set-process-filter process 'elserv-process-filter) (set-process-sentinel process 'elserv-process-sentinel) (elserv-publish-default process) (get-buffer-create (concat "*Log of elserv*" (number-to-string (elserv-process-port process)))) (run-hooks 'elserv-start-hook) process)) (defun elserv-process-port (process) "Get port number of the Elserv server PROCESS." (with-current-buffer (process-buffer process) elserv-buffer-port)) (defun elserv-find-process (&optional port) "Find running Elserv server process. If optional PORT is specified, find process with the specified port number. Otherwise, an Elserv process last invoked is returned." (catch 'found (dolist (process (process-list)) (if (string-match "^elserv" (process-name process)) (if port (if (eq port (elserv-process-port process)) (throw 'found process)) (throw 'found process)))))) (defun elserv-stop (&optional port) "Stop running Elserv server process. If optional PORT is specified, kill process with the specified port number. Otherwise, an Elserv process last invoked is killed." (interactive) (let ((process (elserv-find-process port))) (if process (progn (with-current-buffer (process-buffer process) (if (buffer-live-p elserv-buffer-search-index-buffer) (kill-buffer elserv-buffer-search-index-buffer))) (kill-buffer (process-buffer process)) (delete-process process) (message "Elserv stopped.")) (message "Elserv process not found.")))) ;;; Access log (defun elserv-log (process request result) "Record a server access log. PROCESS is the Elserv server process. REQUEST is the request structure. RESULT is the result structure." (with-current-buffer (get-buffer-create (concat "*Log of elserv*" (number-to-string (elserv-process-port process)))) (let (point) (goto-char (point-max)) (setq point (point)) (insert (car (plist-get request 'client)) " " (if elserv-identity-check (or (plist-get request 'ident) "unknown") "-") " " (or (elserv-result-user result) "-") ; remote user (auth) " " (let ((system-time-locale "C")) (format-time-string "[%a, %d %b %Y %T %z] ")) "\"" (plist-get request 'request) "\"" " " (number-to-string (get (elserv-result-code result) 'elserv-code)) " " (if (elserv-result-body result) (number-to-string (elserv-bytes (elserv-result-body result))) "0") " \"" (or (plist-get request 'referer) "-") "\" \"" (or (plist-get request 'user-agent) "no agent info") "\"\n") (if elserv-access-log-file (if (file-writable-p elserv-access-log-file) (progn (if (> (nth 7 (file-attributes elserv-access-log-file)) elserv-access-log-max-size) (ignore-errors (rename-file elserv-access-log-file (concat elserv-access-log-file ".0") t))) (write-region point (point) elserv-access-log-file t 'no-msg)) (elserv-debug (concat elserv-access-log-file " is not writable!!\n"))))))) ;;; Process request. (defun elserv-request-handler (process request) "Request handler. PROCESS, REQUEST are arguments for request handler." (let ((req (plist-get request 'request)) method func) (if (and (string-match "HTTP/1\\.1" req) (null (plist-get request 'host))) (signal 'elserv-bad-request "HTTP 1.1 client must send a Host: field.")) (if (string-match "\\`\\([^ ]+\\)\\s-\\([^ \t\r\n]*\\)" req) (progn (setq method (match-string 1 req) func (intern (concat "elserv-handle-" (downcase method)))) (if (fboundp func) (funcall func process (match-string 2 req) request) (signal 'elserv-not-implemented (concat method " is not implemented")))) (signal 'elserv-bad-request req)))) (defun elserv-handle-get (process path request) "Handle GET request. PROCESS is elserv process. PATH is the requested path string. REQUEST is the request structure." (elserv-service process path request)) (defun elserv-handle-head (process path request) "Handle HEAD request. PROCESS is elserv process. PATH is the requested path string. REQUEST is the request structure." (let ((result (elserv-service process path request))) (elserv-set-result-content-length result (elserv-bytes (elserv-result-body result))) (elserv-set-result-body result nil) result)) (defun elserv-handle-post (process path request) "Handle POST request. PROCESS is elserv process. PATH is the requested path string. REQUEST is the request structure." (elserv-service process path request)) (defun elserv-authenticate-basic (result value password-alist) "Implementation of basic authenticate type. RESULT is the result structure. VALUE is authorization value from client. PASSWORD-ALIST is the alist of cons cell like: (USER . PASSWORD)." (when (string-match "\\([^:]*\\):\\(.*\\)" value) (let (user passwd) (setq user (substring value (match-beginning 1)(match-end 1))) (setq passwd (substring value (match-beginning 2)(match-end 2))) (when (string= (cdr (assoc user password-alist)) passwd) (elserv-set-result-user result user) t)))) (defun elserv-authenticate (request auth result) "Return unauthorized result. REQUEST is the request structure. AUTH is the auth structure. Return RESULT if REQUEST is not authorized by AUTH. Otherwise, RESULT is set as authenticated and return nil." (let ((authorization (plist-get request 'authorization))) (if (plist-get auth :realm) ; authentication required. (if (null authorization) (funcall (intern (concat "elserv-make-unauthorized-" (plist-get auth :type))) request (plist-get auth :realm)) (setq authorization (nth 1 (split-string authorization))) (if (funcall (intern (concat "elserv-authenticate-" (plist-get auth :type))) result (base64-decode-string authorization) (plist-get auth :users)) ;; OK. nil ;; Try again. (funcall (intern (concat "elserv-make-unauthorized-" (plist-get auth :type))) request (plist-get auth :realm))))))) (defun elserv-check-predicate (request predicate) "Return forbidden result if REQUEST does not satisfy PREDICATE." (let ((host (plist-get request 'client))) (unless (eval predicate) (signal 'elserv-forbidden (concat (car host) " is not allowed."))))) ;; Publish & Service (defun elserv-publish (process path &rest args) "Publish a document. PROCESS is the server process of Elserv. PATH is the requested path. Rest of arguments ARGS are plist of the form (:ATTR1 VAL1 :ATTR2 VAL2 ...)." (let (data set-auth auth predicate host doc) ;; Virtual host. (if (setq host (plist-get args :host)) (setq path (concat host path))) (with-current-buffer (process-buffer process) (when (setq set-auth (plist-get args :authenticate)) (setq auth (list :type (or (plist-get set-auth :type) "basic") :realm (plist-get set-auth :realm) :users (plist-get set-auth :users)))) (setq predicate (elserv-make-predicate-from-plist args)) (setq doc (plist-get args :description)) (cond ((setq data (plist-get args :directory)) ; directory is set. (if (or elserv-search-default-make-index (plist-get args :index)) (elserv-search-add-directory-index elserv-buffer-search-index-buffer path data)) (set (intern path elserv-buffer-publish-hash) (list 'elserv-service-directory doc auth predicate data))) ((setq data (plist-get args :string)) ; string is set. (if (or elserv-search-default-make-index (plist-get args :index)) (elserv-search-add-index elserv-buffer-search-index-buffer path "" doc)) (set (intern path elserv-buffer-publish-hash) (list 'elserv-service-string doc auth predicate data (plist-get args :content-type)))) ((setq data (plist-get args :function)) ; handler is set. (if (or elserv-search-default-make-index (plist-get args :index)) (elserv-search-add-index elserv-buffer-search-index-buffer path "" doc)) (set (intern path elserv-buffer-publish-hash) (nconc (list 'elserv-service-function doc auth predicate data (plist-get args :content-type))))))))) (defun elserv-unpublish (process path) "Unpublish a published document. PROCESS is the server process of Elserv. PATH is the requested path." (with-current-buffer (process-buffer process) (unintern path elserv-buffer-publish-hash))) (defsubst elserv-execute-service-maybe (ppath path host request) "Call service function for PPATH, PATH, HOST and REQUEST, if registered. Return result structure. If function is not registered, return nil." (let (sym func) (when (and (or (setq sym (intern-soft (concat host ppath) elserv-buffer-publish-hash)) (setq sym (intern-soft ppath elserv-buffer-publish-hash))) (boundp sym) (setq func (append (symbol-value sym) (list path ppath request)))) (apply (car func) (cdr func))))) (defun elserv-parse-path (path) "Return a reversed list of substrings of PATH which are separated by '/'." (let ((start 0) parts) (while (string-match "/" path start) (setq parts (cons (substring path start (match-beginning 0)) parts) start (match-end 0))) (cons (substring path start) parts))) (defun elserv-service (process path request) "Provide a service. PROCESS is the server process of Elserv. PATH is the requested path string. REQUEST is the request structure." (let ((host (plist-get request 'host)) path-list ppath rpath result) ;; absolute URI. (when (string-match "^http://\\([^/]+\\)\\(/\\)" path) (setq host (substring path (match-beginning 1) (match-end 1)) path (substring path (match-beginning 2)))) (setq path-list (elserv-parse-path path)) (with-current-buffer (process-buffer process) (while path-list (setq ppath (concat (mapconcat 'identity (reverse path-list) "/")) rpath (substring path (length ppath))) (when (eq (length ppath) 0) (setq ppath "/")) (when (string= ppath "/") (setq rpath path)) (if (setq result (elserv-execute-service-maybe ppath rpath host request)) (setq path-list nil)) (setq path-list (cdr path-list))) (or result (signal 'elserv-file-not-found path))))) (defun elserv-service-directory (doc auth predicate root path ppath request) "Service a directory. DOC is the documentation of the service. AUTH is the autenticator plist. PREDICATE is the predicate to check a request. ROOT is the top directory recorded by `elserv-publish'. PATH is the path string relative from published path. PPATH is the path string published by `elserv-publish'. REQUEST is the request structure (plist)." (let ((result (elserv-make-result))) (or (elserv-check-predicate request predicate) (elserv-authenticate request auth result) (let (filename realfile attr mime-type) (setq filename (concat root path)) (setq path (elserv-url-decode-string path)) (when (string-match "\\.\\." path) (signal 'elserv-forbidden (concat root path))) (if (zerop (length (file-name-nondirectory filename))) (setq filename (expand-file-name elserv-directory-index-file filename))) (cond ((file-directory-p filename) (elserv-make-redirect result (concat "http://" (plist-get request 'host) (unless (string= ppath "/") ppath) path "/"))) ((setq realfile (elserv-negotiation filename (plist-get request 'accept-language))) (if (and elserv-use-negotiation (listp realfile)) (elserv-negotiation-make-result result (plist-get request 'host) (concat (unless (string= ppath "/") ppath) path) realfile) (setq mime-type (elserv-mime-type filename)) (setq attr (file-attributes realfile)) ;; Trace symbolic link. (when (stringp (car attr)) (setq realfile (expand-file-name (car attr) root)) (setq attr (file-attributes realfile))) (elserv-set-result-code result 'elserv-ok) (elserv-set-result-header result `(content-type ,mime-type)) (elserv-set-result-body result (with-temp-buffer (insert-file-contents-as-binary realfile) (buffer-string))) result)) ((and elserv-directory-autoindex (file-directory-p (file-name-directory filename)) (string= elserv-directory-index-file (file-name-nondirectory filename))) (elserv-autoindex result (plist-get request 'host) (concat (unless (string= ppath "/") ppath) path) (file-name-directory filename))) (t (signal 'elserv-file-not-found (concat (unless (string= ppath "/") ppath) path)))))))) (defun elserv-service-string (doc auth predicate string content-type path ppath request) "Service a string. DOC is the documentation of the service. AUTH is the autenticator plist. PREDICATE is the predicate to check a request. STRING is the content string recorded by `elserv-publish'. CONTENT-TYPE is the content-type string recorded by `elserv-publish'. PATH is the path string relative from published path. PPATH is the path string published by `elserv-publish'. REQUEST is the request structure (plist)." (let ((result (elserv-make-result))) (or (elserv-check-predicate request predicate) (elserv-authenticate request auth result) (progn (elserv-set-result-code result 'elserv-ok) (elserv-set-result-header result `(content-type ,content-type)) (elserv-set-result-body result string) result)))) (defun elserv-service-function (doc auth predicate function content-type path ppath request) "Service by a function. DOC is the documentation of the service. AUTH is the autenticator plist. PREDICATE is the predicate to check a request. FUNCTION is the symbol of the function registered. CONTENT-TYPE is the content-type string registered. PATH is the path string relative from published path. PPATH is the published path string. REQUEST is the request structure (plist)." (let ((result (elserv-make-result))) (or (elserv-check-predicate request predicate) (elserv-authenticate request auth result) (progn (funcall function result (elserv-url-decode-string path) ppath request) (unless (elserv-result-code result) (elserv-set-result-code result 'elserv-ok) (unless (plist-get (elserv-result-header result) 'content-type) (elserv-set-result-header result (append (elserv-result-header result) `(content-type ,(or content-type "text/plain")))))) result)))) (defun elserv-package-publish (process path name) "Publish package. PROCESS is the server process of Elserv. PATH is the path to publish. NAME is the name of the package to publish." (require (intern (concat "es-" name))) (let ((sym (intern (concat "elserv-" name "-publish")))) (if (fboundp sym) (funcall sym process path) (error "Cannot publish as package: %s." name)))) (defun elserv-publish-default (process) "Publish default pages for PROCESS." ;; Publish monitor. (elserv-package-publish process "/" "monitor") (elserv-package-publish process "/monitor" "monitor") ;; Publish icons. (if (and elserv-icon-path (file-directory-p elserv-icon-path)) (elserv-publish process elserv-icon-publish-path :directory elserv-icon-path))) ;;; Search (defconst elserv-search-index-buffer-name " *elserv search*" "Buffer name for elserv search index.") (defun elserv-search-initialize () (generate-new-buffer elserv-search-index-buffer-name)) (defun elserv-search-buffer (buffer regexp) (let (bol result) (with-current-buffer buffer (goto-char (point-min)) (while (re-search-forward regexp nil t) (beginning-of-line) (setq bol (point)) (when (search-forward ":" nil t) (setq result (cons (buffer-substring bol (- (point) 1)) result))) (end-of-line))) result)) (defun elserv-search-list-files-internal (dir &optional relative) (let (files) (dolist (file (delete ".." (delete "." (directory-files dir)))) (if (file-directory-p (expand-file-name file dir)) (setq files (nconc (mapcar (lambda (f) (concat relative (if relative "/") f)) (elserv-search-list-files-internal (expand-file-name file dir) file)) files)) (setq files (cons (concat relative (if relative "/") file) files)))) files)) (defun elserv-search-list-files (dir) (elserv-search-list-files-internal dir)) (defun elserv-search-add-index (buffer ppath path index) (when (buffer-live-p buffer) (with-current-buffer buffer (goto-char (point-max)) (insert ppath (if (or (string= ppath "/") (string= path "")) "" "/") path ":" (or index "") "\n")))) (defun elserv-search-add-directory-index (buffer ppath dir) (dolist (file (elserv-search-list-files dir)) (elserv-search-add-index buffer ppath file nil))) (defun elserv-search (regexp) "Search content which matches REGEXP." ;; current buffer is process buffer. (elserv-search-buffer elserv-buffer-search-index-buffer regexp)) ;;; Utils (defun elserv-replace-in-string (str regexp newtext &optional literal) "Replace all matches in STR for REGEXP with NEWTEXT string. And returns the new string. Optional LITERAL non-nil means do a literal replacement. Otherwise treat \\ in NEWTEXT string as special: \\& means substitute original matched text, \\N means substitute match for \(...\) number N, \\\\ means insert one \\." (let ((rtn-str "") (start 0) (special) match prev-start) (while (setq match (string-match regexp str start)) (setq prev-start start start (match-end 0) rtn-str (concat rtn-str (substring str prev-start match) (cond (literal newtext) (t (mapconcat (function (lambda (c) (if special (progn (setq special nil) (cond ((eq c ?\\) "\\") ((eq c ?&) (substring str (match-beginning 0) (match-end 0))) ((and (>= c ?0) (<= c ?9)) (if (> c (+ ?0 (length (match-data)))) ;; Invalid match num (error "Invalid match num: %c" c) (setq c (- c ?0)) (substring str (match-beginning c) (match-end c)))) (t (char-to-string c)))) (if (eq c ?\\) (progn (setq special t) nil) (char-to-string c))))) newtext "")))))) (concat rtn-str (substring str start)))) (provide 'elserv) ;;; elserv.el ends here elserv-0.4.0+0.20011203cvs/elservd.in0100644000175000017500000001324107325235720014646 0ustar bg66bg66#!@ruby@ # -*- ruby -*- # elservd - A daemon process for elserv # Yuuichi Teranishi require "socket" require "thread" require "timeout" require "monitor" if (ARGV.length != 5) STDERR.print "error: wrong number of arguments ", ARGV.length, "\n" exit(1) end CRLF = "\r\n" STDOUT.binmode # Arguments: # port-number {log|nolog} max-children max-keep-alive keep-alive-timeout ident = true if ARGV[1] == "log" max_children = ARGV[2].to_i if ARGV[2] != "0" max_keep_alive = ARGV[3].to_i if ARGV[3] != "0" keep_alive_timeout = ARGV[4].to_i if ARGV[4] != "0" keep_alive_timeout = 15 unless keep_alive_timeout session_hash = Hash.new (nil) class ElservClientSession def initialize (socket, max_count = 0) @socket = socket @max_count = max_count @serve_count = 0 @key = @socket.peeraddr[1].to_s @keep_alive = true @mutex = Monitor.new @cond = @mutex.new_cond @running = false @closed = false end def set_close! () @keep_alive = nil end def key return @key end def peer_host return @socket.peeraddr[2] end def peer_addr return @socket.peeraddr[3] end def wait @mutex.synchronize do @cond.wait_while {@running} end end def start @mutex.synchronize do @running = true end end def closed? () return @closed end def gets () return @socket.gets end def close () @socket.close @closed = true end def serve_page (content) # serve_page may close the socket. @socket.write (content + "\r\n") @serve_count += 1 if (@max_count != 0) if (@serve_count >= @max_count) @socket.close @closed = true end end if !@keep_alive @socket.close @closed = true end @mutex.synchronize do @running = false @cond.signal end end def read (length) return @socket.read (length) end def read_chunked() len = nil total = 0 body = "" while true do line = @socket.gets m = /[0-9a-fA-F]+/.match(line) m or close # XXX len = m[0].hex break if len == 0 body << @socket.read(len) @socket.read (2) # CRLF end until @socket.gets.empty? do ; end return body end end # emacs elservd # <=== greeting:port === # === connect ===> # <=== request,key === # === key:length,CRLF ===> # === content, CRLF ===> # ## Emacs thread Thread.start() do emacs_daemon = TCPserver.open("localhost", 0) ## Greeting. STDOUT.print "elserv-port: ", emacs_daemon.addr[1], CRLF, CRLF while TRUE ## EMACS thread. esock = emacs_daemon.accept content = nil sport = nil while line = esock.gets # wait for the emacs response. if line =~ /^stop/ # emacs sent 'stop'. emacs_daemon.shutdown(2) esock.close() elsif line =~/(\d+)([:;])(\d+)/ # emacs sent port:bytes content = esock.read ($3.to_i) esock.read (2) # CRLF session = session_hash[$1] if session if ($2 == ";") # ';'=> close ':' => keep_alive session.set_close! end session.serve_page (content) end else # invalid. close connection esock.close() end # end of EMACS thread end end end session_count = 0 m = Mutex.new ## MAIN thread gs = TCPserver.open(ARGV[0]) while TRUE s = gs.accept ## end of MAIN thread Thread.start() do ## SESSION thread sock = s # thread local # identity check user = "" if ident begin isock = TCPSocket.open(sock.peeraddr[3], "auth") rescue isock = nil end if isock isock.write (sock.addr[1].to_s + ","+ sock.peeraddr[1].to_s + "\r\n") igot = isock.gets.split(/: */) if igot user += "elserv-ident: "+ igot[3] end isock.close end end # end of identity check session = ElservClientSession.new (sock, (max_keep_alive or 0)) m.synchronize do session_count += 1 end # LOCK OUT! if max_children and (session_count > max_children) session.close end first_request = true while !session.closed? req = "" force_close = true chunked = false content_length = 0 if first_request # first request. while (got = session.gets) != CRLF if got =~ /^content-length: *(\d+)/i content_length = $1.to_i elsif got =~ /^connection: *keep-alive/i force_close = false elsif got =~ /^transfer-coding: *chunked/i chunked = true end req += got end else # requests while keep-alive begin timeout (keep_alive_timeout) do while (got = session.gets) != CRLF if got =~ /^content-length: *(\d+)/i content_length = $1.to_i elsif got =~ /^connection: *keep-alive/i force_close = false elsif got =~ /^transfer-encoding: *chunked/i chunked = true end req += got end end rescue TimeoutError req = "" end end first_request = false if req == "" # bogus null request. force_close = true session.close else if chunked body = session.read_chunked body = [body].pack('m').chomp.gsub("\n",CRLF+" ") req += "elserv-content: " + body + CRLF elsif content_length != 0 body = session.read (content_length) body = [body].pack('m').chomp.gsub("\n",CRLF+" ") req += "elserv-content: " + body + CRLF end session_hash[session.key] = session session.set_close! if force_close session.start STDOUT.print user, "elserv-key: ", session.key, CRLF, "elserv-client: ", session.peer_host, " ", session.peer_addr, CRLF, "elserv-request: ", req, CRLF STDOUT.flush session.wait end end # end of while !session.closed? m.synchronize do session_count -= 1 end ## end of SESSION thread end end elserv-0.4.0+0.20011203cvs/es-demo.el0100644000175000017500000004526007325531552014535 0ustar bg66bg66;;; es-demo.el -- Elserv demo. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; ;;; History: ;; ;;; Code (require 'elserv) (require 'calendar) (eval-and-compile (require 'cl) (ignore-errors (require 'w3m))) ;; calendar (original was in the httpd.el) (defun elserv-demo-calendar (result path ppath request) (let (year month prev-year prev-month next-year next-month) (if (string-match "^/\\([0-9]+\\)/\\([0-9]+\\)" path) (progn (setq year (string-to-number (match-string 1 path))) (setq month (string-to-number (match-string 2 path)))) (setq year (string-to-number (format-time-string "%Y"))) (setq month (string-to-number (format-time-string "%m")))) (if (eq month 1) (progn (setq prev-year (- year 1)) (setq prev-month 12)) (setq prev-year year) (setq prev-month (- month 1))) (if (eq month 12) (progn (setq next-year (+ year 1)) (setq next-month 1)) (setq next-year year) (setq next-month (+ month 1))) (elserv-set-result-code result 200) (elserv-set-result-header result '(content-type "text/html")) (elserv-set-result-body result (concat "Emacs calendar\n" "

Calendar for " (number-to-string year) "/" (number-to-string month) "

\n" "prev\n " "next " "
\n"
      (with-temp-buffer
	(apply 'generate-calendar (list month year))
	(buffer-string))
      "
\n\n")))) ;; list-buffers (defun elserv-demo-buffers (result path ppath request) (let ((buf (and (not (string= path "")) (get-buffer (substring path 1))))) (if buf (progn (elserv-set-result-header result '(content-type "text/plain")) (elserv-set-result-body result (with-current-buffer buf (encode-coding-string (buffer-string) 'iso-2022-jp)))) (elserv-set-result-header result '(content-type "text/html")) (elserv-set-result-body result (concat "
    \n" (mapconcat (function (lambda (buf) (let ((name (buffer-name buf))) (unless (string= (substring name 0 1) " ") (concat "
  • " name "\n"))))) (buffer-list) "") "
\n"))))) ;; POST (apropos) (defun elserv-demo-post-apropos (result path ppath request) (elserv-set-result-header result '(content-type "text/plain")) (elserv-set-result-body result (save-window-excursion (if (apropos (nth 1 (split-string (plist-get request 'body) "="))) (with-current-buffer (get-buffer "*Apropos*") (buffer-string)) (concat "No apropos matching for `" (nth 1 (split-string (plist-get request 'body) "=")) "'"))))) ;; A counter (defvar elserv-counter-file-base "/tmp/elserv-counter") (defun elserv-counter (name) "Return count for NAME." (let ((file (concat elserv-counter-file-base "-" name))) (elserv-save file (+ (or (elserv-load file) 0) 1)))) (defun elserv-demo-counter (result path ppath request) (elserv-set-result-header result '(content-type "text/plain")) (elserv-set-result-body result (format "You are %sth user." (elserv-counter "demo")))) ;; POST (upload file) (defun elserv-demo-upload (result path ppath request) (with-temp-buffer (set-buffer-multibyte nil) (insert "Content-Type: " (plist-get request 'content-type) "\r\n\r\n" (plist-get request 'body)) (elserv-set-result-header result '(content-type "text/plain")) (elserv-set-result-body result (buffer-string)))) ;; antenna (requires w3m) (defun elserv-demo-antenna (result path ppath request) (elserv-set-result-header result '(content-type "text/html; charset=iso-2022-jp")) (elserv-set-result-body result (encode-coding-string (save-window-excursion (with-temp-buffer (w3m-antenna) (w3m-with-work-buffer (buffer-string)))) 'iso-2022-jp))) ;; history (requires w3m) (defun elserv-demo-history (result path ppath request) (elserv-set-result-header result '(content-type "text/html; charset=iso-2022-jp")) (elserv-set-result-body result (encode-coding-string (save-window-excursion (with-temp-buffer (w3m-db-history) (w3m-with-work-buffer (buffer-string)))) 'iso-2022-jp))) ;; weather (requires w3m) (defun elserv-demo-weather (result path ppath request) (elserv-set-result-header result '(content-type "text/html; charset=iso-2022-jp")) (elserv-set-result-body result (encode-coding-string (save-window-excursion (with-temp-buffer (call-interactively 'w3m-weather) (w3m-with-work-buffer (buffer-string)))) 'iso-2022-jp))) ;; describe-function (defun elserv-demo-describe-function (result path ppath request) (elserv-set-result-header result '(content-type "text/plain")) (elserv-set-result-body result (concat (save-window-excursion (prog1 (describe-function (intern-soft (substring path 1))) (message "")))))) (defun elserv-demo-publish (process path) "Publish DEMO service. PROCESS is the elserv server process. PATH is the path to publish DEMO content." (elserv-publish process path :string (encode-coding-string (concat "Elserv\

Elserv: Yet another HTTP server on Emacsen

\ $B$b$7$3$N%Z!<%8$,FI$a$?$N$G$"$l$P!"(BElserv $B%&%'%V%5!<%P$N%$%s%9%H!<%k$,$3$N7W;;5!$GL5;v$K=*N;$7$?$3$H$r0UL#$7$^$9!#$"$J$?$O!"4X?t(B elserv-publish $B$K$h$C$FJ8=q$r(B $B2C$($?$j!"$3$N%Z!<%8$rCV$-$+$($k$3$H$,$G$-$^$9!#(B

$B%G%b(B

$B%+%l%s%@!<(B ... calendar $B$rI=<($7$^$9!#(B
$B%P%C%U%!0lMw(B ... $B8=:_(B Emacs $B>e$K$"$k%P%C%U%!$N0lMw$rI=<($7$^$9!#(B
$B%P%C%U%!0lMw(B ... $BF1>e(B($B$?$@$7(B localhost $B0J30$O5qH]!#(B)
$BG'>Z%F%9%H(B ... $BG'>Z$N%F%9%H(B
$B%-!<%o!<%I$r$7$i$Y$k(B ... POST $B$r;H$&Nc$G$9!#(B
$B%U%!%$%k$r%"%C%W%m!<%I$9$k(B ... POST $B$r;H$&Nc!"$=$N(B 2$B!#(B
$B%+%&%s%?(B ... $B$$$o$f$k%+%&%s%?!#(B
$B$"$s$F$J(B($BMW(B w3m) ... emacs-w3m $B$N%"%s%F%J5!G=$rCf7Q$7$^$9!#(B
$B%R%9%H%j(B($BMW(B w3m) ... $BF1$8$/(B emacs-w3m $B$N(BDB$B%R%9%H%j$rCf7Q$7$^$9!#(B
$BE75$M=Js(B($BMW(B w3m) ... $BF1$8$/(B emacs-w3m $B$NE75$M=Js$rCf7Q$7$^$9!#(B
Powered by " (elserv-version) " ") 'iso-2022-jp) :content-type "text/html; charset=ISO-2022-JP" :description "Elserv demonstration.") (elserv-publish (elserv-find-process) (concat path "/calendar") :function 'elserv-demo-calendar) (elserv-publish (elserv-find-process) (concat path "/buffers") :function 'elserv-demo-buffers) (elserv-publish (elserv-find-process) (concat path "/buffers-local") :function 'elserv-demo-buffers :allow '("localhost")) (elserv-publish (elserv-find-process) (concat path "/auth.txt") :string "Hello World." :content-type "text/plain" :authenticate '(:realm "HelloWorld" :users (("foo" . "bar") ("hoge" . "fuga")))) (elserv-publish (elserv-find-process) (concat path "/apropos.html") :string (encode-coding-string (concat "describe-function

Emacs $B$N%-!<%o!<%I$r$7$i$Y$k(B (apropos)


") 'iso-2022-jp) :content-type "text/html; charset=ISO-2022-JP") (elserv-publish (elserv-find-process) (concat path "/function") :function 'elserv-demo-describe-function) (elserv-publish (elserv-find-process) (concat path "/apropos") :function 'elserv-demo-post-apropos) (elserv-publish (elserv-find-process) (concat path "/a") :function 'elserv-demo-antenna) (elserv-publish (elserv-find-process) (concat path "/h") :function 'elserv-demo-history) (elserv-publish (elserv-find-process) (concat path "/w") :function 'elserv-demo-weather) (elserv-publish (elserv-find-process) (concat path "/counter") :function 'elserv-demo-counter) (elserv-publish (elserv-find-process) (concat path "/upload") :function 'elserv-demo-upload) (elserv-publish (elserv-find-process) (concat path "/upload.html") :string (encode-coding-string (concat "$B%U%!%$%k$N%"%C%W%m!<%I$8$c(B

") 'iso-2022-jp) :content-type "text/html; charset=iso-2022-jp") (elserv-publish (elserv-find-process) (concat path "/data") :directory "/usr/local/www/data") (elserv-publish (elserv-find-process) (concat path "/logo.gif") :string (base64-decode-string "R0lGODdhvQBEAPcAAAAAAICAgEBEQLjA0FhgaFhgoEBEgHiAuNjg6CAgIKiwuDAwMFBQUH BwcMjQ2GhwoJCQkJig0FhggFBUiDhAYKiw2CgwWLjA4CAgQGhwwOjw+EhQaNDY4IiQ2HiA qKCosFBUoEBIYGhwiFhkuLC4yGBoiAgQGICIsCAoMDg8OODo8HB4qGhoaJiYmMDI4FBYcM DIyDA4YICIoBAYKJCYwKCoyFhYgJigwGBoqEBMiMjQ4LC44NDY6EBIeEBIWKiwwJCY0HB4 kODg4DAwUHB4gFhgkDhAeCAoSKCouICI0MjI4DA4aIiIiGBgcGBkqBggOGhwuEhUkHB4yF BQaFBcqLi4uGBomCgoKKCo4EhMkMDAwKCgoHiAyPj8+ICAoGBowBgYGDA4UHB4sJiYsDhA WNjY2EhIYOjo6GhseFhYaMjIyDg4YIiIoBgcMNDQ4Li40JicyHh4kODk8CgsUMjM6Li8yC gsOMDE0KCksICEkFhgsLC0sDAwQAgMCICEsJCUuKCk0LC00MDE2JCUyHB0kIiMuEhISGhs uFhcqGBkYNDU0HB0oGBkiEBEaDA0YPD08KisqGhsgHh8qBgYMKis0KCkwEhMiNjY8EhMeL C0yHh8eJCQoGBkkEBEeCgsSKiswIiM0Dg8cCAgOFhcWHB0uFBUmGhskKis2ICE0Dg8UHh8 sEBEWFBQYHBwgGBkuJicqFhckHB40FBUeICEqJicwOjs+FhceLi84Jic2Hh8mLC04MDA6H B0mBAUIIiMwNjg8IiQwEhQeMDI6JCY2GBksAgMGKCk2GhsyFhcsICEgFhkqEBIiHiEuCAk IDA0MFBUUHB0cJCUkFBYgCAkQGh0yFBYoGhsaJicmFhcgGBssODk4DA0UICMyMjM4IiMiG BkeGh0sHB8yFBUcLi8uCgsKEhQkMDEwKCkoICEmGBsyBgcGHB8uJicsNjc2EhMaOjs6Fhc cMjMyDg8WIiMoNDU6Li82Hh8iAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAvQ BEAAAI/gC7CBxIsKDBgwgTKlzIsKHDhxAjSpxIsaLFixgzatzIsaPHjyBDinT4qJacS3IG PlrJcqTLlzA1PlJx6VKtRwRr8ri08xJOnDGDCh1K8FFNmwJ3YRnkClRPXboqQFXy7t1Kol izejTK810XYUC+fDHWTc5OHRlGqNXDtp4QIWeuap1LFyLXS7+67Ij1RcopIe3KINjJZe0I ZGxxfIpX5ozXupAjG6RZU8UtvulwtVOkKF48epcujHC1lq0eYlsgaWn8WLLruVx3CguX7g sqNfHUaBmnxVxNUGtd6RnBlpMmCJDUtLP6ujnRu/SGpZsOR/e4PXuqjOvGMy1p4oj1/rAa Ba1FlTLMnat/aVR2rHTHjlG6Dql+di0Oao4ezl8PFWeGsODNHorEtd6BIZ200w7THSNFJn t8sMUr50CyhxaKcHBJBd+Bx1Y5zaSQCBOQFAgUgihqVAtPl2BxDHzh/ADJNdG00IKFMCjS jhCX7KCWcMSxtUwCIjKxR2MnpqgkRSvu1AF86cQiIQQQeNPCOXuooYg2Vm1IWn96IOOEMw Ik4s15rSlkVC1LtqnSUR0cQw18N7TARDJMQLBFFWqUoQ1LGuhC3KDhIUOOACxEMw56SR4U W6NuHtheiw2m8wcEyWgSgDdbZNlOXCe+451pbFGBTDAstLBomgixWEEB/r48UpVckTb3S0 0MxpcOF97YA40mTFyzRzyfJilrIIewdZgey1jSyAYNKMqoQmZtWE45WdwBF6i1ukRrQyeF 9iI1cnqjSQMNBBCNp1Y1+kg7WmyhySgpLEDOoc9ocs1q6R2kQU10XIttJbgh2e1I4d7EUH s6vPdiOidAwwILx0FiTrEGraRNPHt408AohhjCwCjWMHEOv5AOpBM412aRxSYWmmPwwR+1 p1RNZ9yU8q2XPPniMapAk0giDSRzsp8pdyFrGVpAAkEA0DTwa7BVxCMEqwQ1CQi21+aQCw TCWo01zRk1mUQ64eByQU1yyNFvuLnOSY0mQ1N8TRVbJi3Q/iNnKALDHpC8cs01FY6jHLcH 8URHAS1jW0LRW2hxtd5kU2TWLvD9nPbaR8GleCw/p7NIIqOQh5waky/0zhlCdGaOGq9zBt fYAlU7iMDYZlF6eWhW3lFNuEAZ+osdYLFLT5cEP6eciTwzSiLJbCFzvwmttPpbgAmhjWOU AyxwFuXkkIUAhlgDwXkG+q6RWUkML3zoSXRQgfDp6PLJJ5tEA0nVf1JelPUs+YlCVsa13J UDQCyAwJFopz6KXGI6y6Nf6KZTqRftQCcsqkkZUNK2DnqwFrV4B5uUtreGPGInF8BdFnJQ jh4sAFHSol4DLfKI9kGJXOnA4fJ+5r7adKB4/juogA6Qd5Qido5b/iNIT5TROGxZIgYvtI aqrjZDmVyCNg+DkgTnlEMKHuMLtRGLGMUyAmqAghtnPCM30JgESryhHvVoVxKbFIFygAB8 2BIfChZgCGhcwxxCSGIVTdg3YJArdDiMUoMelkUwjnEEX4Dkj9QSJFIh4xCZKNa3MrYTOo AAd1zrRAIWkK9zqMExg8zIGTgwjhaIQBnE0CIj6degMT4ykt/5kiWp4AcSaKFPgaScgm7X OPHlAAUhGoWRTJTKi6ykHWqABBMa8AwfNKIR1cgG6LRYS7GEkYyuwOVogmOaEQQhD2DbH2 PS56+a3AKU4MtCJ9RxhfKpalrN/qThGZgGCXOxYBQMEAASLkGHCtbmoLccZyQHxZYCSKAJ iWBBAzThDWHJrH+t4gkpoqDCHCwDDAlwxjMCsAXUQUph+STJI7TBAXPsYQuYgoY16MCDHW RRD30oBhgcsQ1HYOJaE4hCKYQ6gVKEwAzuEAD5RPY8awCrU31iZ0H+xQNjfI9rlkiAOsgR IAUy8001SSlErqcIc1QBEltogZNqmQUwgIGeC3BGCuTqjLrONQV4VSr5GOA8olH0GqrZkg xVVhNlcPR7ORgCPVMwigCYsh20ahJPaOGGlojkEb9IiXNkdYZ2cCA3MODJNsHYiAQ044WG GMUzmqfaZzDgtXzt/mtEJ5oMK+1PS6k7yBluFYFPXnUb6gjRM/y4KHbSZCcVgIURjHCG5g 7WUSa5lRyS+K+aCJKGKI0IS5orhA1ewpG1acQVAES0ACQjAOgNgCbWy970egMC0dgClsZh Dh1htFU8oAMTVbiGZoyXAeYb1p8IWxNgLLcThVBEGT713IGYxIjWtWxBwvWLejQCG1ZpcE UUhJSJ/OQRZtGFI8USAjKNQhPRqBDg6nOOFru4QgrIDn21VIbZbTJrPBnEYblGhiuMN0De SE5udYKAdXTCCAYIhha0E9WkrYjIOzjBCnpggUXcwbm04hkPxnCEaTRCETa+LkMyGIhcsC PDYiZI/oi/+QUzpIAB0bpQPDrjGdyo4c6embOCd7Q97vlPcdfybTnMYC8Emmx6PzkKHUph hCMbYRGCOwefcpsTvMiBDjTAhAUcsWkLbHo1cPmJEGTzgC43QgueqbGGBWKSMdfEBSHoRT GKsYltrfogJ8GFLTGRgnxtYVHb4u4ZtEFsuPR5VhJWSHWB4VvwTeGuATLaatjJk26UohMG aPRy7REAk027IEbRLCUcQW5ye5rTFmADn1hzFGE0YhpzmIYptHCfAjGwC0VUCGVc4AlZzz oNBUMlRMzSAVuWgrGaELIcA8hwAUbkVjwQdDlsYQi8MoAFyVANBxDXhUszOttIXq4R/r6B YgKxsxY8YBM9guEIKwRhGZxG9xwsUPKL6UQJnThCl6dBgR0ooT7TTllsXOCBViAA2WB1AR 9MYIJZ92EKFmrywC8BCjJG8gu9dmw87msREIK7JnUUWCSeodRnYPxkecuJCrrRiWWEPBSO DgU8Mm5SnJwBKQNwhCQ4sBkeLGLTc+D0GhKhiRYQSHFH8AS8Fz8NWeygU1bb5KSEkYoZTG IIb+GeQKjKiGLI2t9oYMKN6v6Qk3QAklcfQQgYoImSBjIjbZvwTpxw2Diw4LXPKBnaEQfi nzwg5HEPRaOjhbe4rCgvknBEJbRRBkWo4RIukLkFVsEA6EEiHgi4hBE8/qHzaex8GuBvhD cwxPVJ1WASlp/BEAqWupOQwAT+zmkqEmENaaMHIv9KwtVdEU5ElO8a4wBZaYYQbQMIgLA3 uCIws0A3paN75HciJVE7sPAHSMBoRgB3yxUKoSAOjqUc72Bdf7AEf9Bd8QADoEEPneYI8m BiAQAJSoAAZyABRzAHOtd94DcNGPAELQBqJ8IiNTADbZB+aQB09tYFNFEIn+d5nvAMzlN4 WrAcYnZCBSdJlIQNieBVUuVAjwAKsfIO4SIG13IpQpMI0OBtJgIU6XEJD9ANQqAGH3BtFx iHwicgh4cAciAIS8AJrRMPbnAJ9HAHm4BujYBXhjAieHM1/rzgfUeAAYvYZTmIg/aweytx FOcXhOg3CSIgeqrBKJjFCE03awlgCORzYpGzHBHRIpBEGqo4AoRnSlTUdT6xDoXQXDWhAx xVCOfABOdCUZs4YAYhCOzAN2UQTa9ggcKngaHga77BA/TgCDGgBBpCDw5wB+NwDp1gARTw DSCTWtBwDvV1BpnAC2pQBXEQCjZ4g2TQAEGGOl74L8JgiZY4A/SHYujzE3GQhKsgAClQiC QSeacoKLn0IxkwD1h4b2MmB2cAAm7RDjsBDOVQAFVwDboYAMjxgAcRCLugMdD0UiQAd8cY CktQJt7gBjvBCUtwAvQwjtiBB6ZgAT3gBdcQ/gAsQABEMyBqgACZkAl9UwUt8AmmgIPT8A TTYAEId0+v5wJh0AaTEI8zwFcBxkxyQA/9llPo0ADNEy3FNYAfOEnjxBaHgATnUFwGmRA0 UQsVEAUZogg84QTloAqQ0ALJkAwphiEcNxDNpTTvoA2bQW+QcArIeIyM5Q07cQtLsAToMA YewAmM4Ag9YArsYFbn8DTQsCmbaA5vkJeKoAXn4AZKcIPT4An/hZWKMF1yEAmAsJTph377 OCImxzeysgezVgyiAA+F2ILKcWMLYRSF0ZUMBQWnwBtIMoBPpgJOIAZl8BkEdS0F0E958m tp9z8qwVnd5TdVwAM4cIFLEArb/uAMDNACPMEJjrAEmFACjEAI6BCWrzOOMxIN8VUi9KAN CMBZw8gdLmAG4BcG5LAAjAUNkXMJKvAI87ATQciU+smaiuCFN/EOcbAFtuB025AG9iBgA6 g0coAFQAImpjEMgsAZmucQCvIIvlAKgBAP5kAPPFABAqMKn+AN+uOBkYUTTzZdw6aX03kJ 9aCBRrAE+vkMJHAJSlCYjnAOr+ANLLo/vbEbZ2UhWkAPGydHrKMhPFAFjjANU1BxAgBgTK AFPCCAdSAMlwCEYGp5diAiZzKazOEFsLMFyZAGrMAKUlR8uJmbPMAflWQaiHEIxuCHDOY/ klULvhAFTlBWVVAT/szANVlwAHRwB1UAA6GmNHfHapRwCzthbMM2bNnHA8gYAng1CvVwCT VQmCLYAuaVYhdiDqaqBb+kCPQwO5vQDZx1qZdQAtMQAkLjPInSDTzgJ+3QCpnAE0qZmjMw pmbiGwMWCZ/QhnsQDZlCUWH5nNolBMagB8LRH4ViKtkABHRQE0KAkChVEg+2E8woBp9UB2 a1BzsBBYZaDrAQATR1CQjAIyixEmcADJJaCNkmCXzmGNmnCDnaCQwgMiwwAJewAkDqCDXQ DQqAB0qKG3NmopewPe0gAXUgr7D6AODnBdPEnzrgh2DGDmugkzUBhJc4AzPQCHjwA31YIO 0QCTop/gTx0DSvUCOdIjN1SRJ9kwGkwhbIQAX+sbPIsLNSYAxKQERF1BN0AAQgEAUgQAvX gR080TLGtEKWoAqnMLR48Q5CAAelkK0RkG3Z9gey0w4PSwnCRwSkQ3h3MLDhubZF8AZHwY xFhABcUgmdsBzcxSIicIM0MADcwRM8EA91IA5r8APwORhBmH6W1wuVwBOLugme8AnDthkv WwXYUQX1hTET8Q5lEAg6GyY827M7iwhUQAWIUA1UUA1JMAgVUAEXgEIVMAjgAAKfVArrQL ktBgn50ThSmwXLsELLsAyqIAnLYACmQJII8HGNJgF7UKLuegZWEAoEqQlOBQE9uggF/ltu PXACNaAELMIDCKAItGAGnVAg2iAEl6oE0gB+GDAN8pB9PCEI6LAGbbAGxNJ8oGF56EeyM9 ALM+AO/ttveNAOAlwGzccZncEZe+phKxUPtFAqnvuzoxu6plsNyFANFnzBFlwKspu0srsC aGUjWKIGPJBHK8S7vPu7Jzy8KwAD8XAJt6BtIncLPMEYkrAElbAHErkpJ8MBixADa2tuMe dpPcALNjAHRtwJfaJggrETFuuZGCAPVmAKMYABbfAEMYBqeAYaMQCs/NsLXtwLJsAGv6Rn C4Y9xNZccWpC79AO41AInvvApEu6Fly6GGzBGwwC1aC0SSsD0VAltoVq/pdwACVcwij8u8 O7DF6gYjpACV4bchNAAlvADrwQCkigBntwDjWyPwp2Cz9cbp3maRYwc0YcCaYKA7ihlp4K fjsnlKwsClVsBpBAAlWgHeaQHyWQfr2Afl3sxWhAqr1hX3GxcBMKbmfAMehgKqE7unR8un VcDXictM6sx0XAbdyWDHqSJTVWD5Ygtb3buwZgyJZAeExAqvQAco52gchIA7uxYpAwDsRS vkVAbksAxJ02BKI8B0GQGhZCXwqGAKbwfeD3BBiQgwK9ATYiX/tjDi2cC/k7CV28v22wCh RDqvU1OQ6XEbLShpCQB6LrsxZ8uhVcx8+Mx3ocBRIQURKl/gnJYHgw4CfluwIm7FEpvAxk cKVEwwSpMQ6ccM5yGAxBhh1AjSFXk5fmkAPlFsSeJsoxgAYqDQE3widgJgde0GVHIJTrK9 BPIAruQFu2tW7tUAmIu7/7Ownk0Gv1B1XtwHUcsTTmIE2MMLrVULohLdJRkMcbHAUbIDJ9 BQ0rrQAXJSvaoAiSYAnd/LuYEAM+to/kwSlVoAWZYAmNdoyd4A6JQJGpkR2XCyr7tAdGkI LnNnOO0AgjQ4ZyqU4MRg8UsL6LGJQ5eASpkFribFE1ppfbQLIOvb+iAAbC1QAmMw5glsYY IYxN4zE2UArNfMEj7cw9EANlnQI+sFplKNv9/rM04wABJRAMmNAJipUAV/BCJBM9y9sZe8 AL2IAJmCAPKSAAo8DbgAXVqbMSLgsJEtDZnRZ4QxBXNl2GaM0976AGifiIAu0JpyUAZodi FrMljqENY5C/vTANCaDbfER4hic2w2wXzNfW0UA3DBACllAOyJ205WAEMYAC6oAC5CBXqU Ux3iBphyMXj+CyHUNN+phXhkAAvC1pjEGCMf4MIVN90LDiWSJYELhP4yAvL2AGqbAN5OBj +plaJSMsLW49QmAOm/ANFBAD23AFzVDWhQgNFSnkwggJ8OAOFZefq1lyLc4enWXJamqVAV UvV4BMzTDnV2Dmo8gC0X0hYMZx/mztNNJbOqOA5ysdWAymAvzkDRITURQ1s34iQyulCBEZ AM2jV+QD3Yy9Tl4hahzjMaOgj0pVfQYu1FfxTNGUDCzA4ym+0lWDud6S0YpwHXaiCf+E6p Te488zUZyiGoyh1nuzT2wOAXeSJ4BlOI3OEoHdNC1ApF3dJ7zOEi5bBVtgLlYZUU5VUbre qCqxT23tT3WT58xOK8JYjbooNerSzhQuFIDdDi+rAFsQDUygXg1gDSwg71Kj0rYlZ8UudH yj7ku2BzHW2LvOeys1jE27B4ajIzWrEpjpUufQAn0cDYQjZ2ndLuDGfPT2Cn6sJ+2M8JDy 6E0zOK8QdfZW4cGduJebYQ70sQWDYyMtcA363NhaMvHAjZedVcAZIvPuwjeAwRkEnMBqsu /ONw7jMMupWuwIoZEkSrn38c7PBdjDaA6oOmehRvIYLZ2SCzuoiqrpefPbk2zVg5erg2Vp bD3N5WcPAdiAUQYcUMaOkelqkpfTefNmf/Q6L8A7kvBYwRJh/xZ2vyPag8YzXz2jThJKc9 GELyuzQvEqVRWM7/V0LyuODxkN13AktCRAYfjaRUIDiPli1fkxERAAOw==") :content-type "image/gif")) (defun elserv-demo-start (&optional port) "Start a demo server." (interactive (if current-prefix-arg (list (string-to-number (read-from-minibuffer "Port: "))))) (elserv-demo-publish (elserv-start port) "/")) (require 'product) (product-provide (provide 'es-demo) (require 'elserv)) ;;; es-demo.el ends here elserv-0.4.0+0.20011203cvs/es-mhc.el0100644000175000017500000003763307325156600014362 0ustar bg66bg66;;; es-mhc.el -- Elserv interface for MHC. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP, Schedule ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; (require 'elserv) (require 'mhc) (require 'mhc-face) (require 'mime-view) (require 'custom) ;;; Code: (eval-when-compile (require 'cl)) (defgroup elserv-mhc nil "Elserv interface for MHC." :group 'elserv :group 'mail) (defcustom elserv-mhc-default-port 10000 "*Default port for MHC." :type 'integer :group 'elserv-mhc) (defcustom elserv-mhc-icon-publish-path elserv-icon-publish-path "*Path to publish an icon directory specified by `elserv-mhc-icon-path'." :type 'string :group 'elserv-mhc) (defcustom elserv-mhc-icon-path elserv-icon-path "*Icon image file path." :type 'directory :group 'elserv-mhc) (defcustom elserv-mhc-background-image "background.png" "*Background image file." :type 'string :group 'elserv-mhc) (defcustom elserv-mhc-article-icon-image "article.png" "*Article icon image file." :type 'string :group 'elserv-mhc) (defcustom elserv-mhc-icon-image-alist '(("Conflict" . "Conflict.png") ("Private" . "Private.png") ("Holiday" . "Holiday.png") ("Todo" . "CheckBox.png") ("Done" . "CheckedBox.png") ("Link" . "Link.png")) "*Alist to define icons. Each element should have the form (NAME . ICON-FILE) It defines icon named NAME created from ICON-FILE. Example: '((\"Holiday\" . \"Holiday.png\") (\"Work\" . \"Business.png\") (\"Private\" . \"Private.png\") (\"Anniversary\" . \"Anniversary.png\") (\"Birthday\" . \"Birthday.png\") (\"Other\" . \"Other.png\") (\"Todo\" . \"CheckBox.png\") (\"Done\" . \"CheckedBox.png\") (\"Conflict\" . \"Conflict.png\"))" :group 'mhc :type '(repeat :inline t (cons (string :tag "Icon Name") (string :tag "Image File Name")))) (defcustom elserv-mhc-todo-title-format "

TODO(s) at %s/%s/%s

" "*Todo title line format." :type 'string :group 'elserv-mhc) (defcustom elserv-mhc-calendar-title-format "

Calendar of %s/%s

" "*Calendar titleline format." :type 'string :group 'elserv-mhc) (defcustom elserv-mhc-calendar-cell-width 100 "*width of the calender cell." :type 'integer :group 'elserv-mhc) (defcustom elserv-mhc-calendar-cell-height 100 "*height of the calender cell." :type 'integer :group 'elserv-mhc) (defvar elserv-mhc/path nil) (defvar elserv-mhc/icon-image-alist nil) (defun elserv-mhc-publish-image (process ppath path file) (let ((file (expand-file-name file elserv-mhc-icon-path))) (when (file-exists-p file) (elserv-publish process (expand-file-name path ppath) :content-type (elserv-mime-type file) :string (with-temp-buffer (insert-file-contents-literally file) (buffer-string))) t))) (defun elserv-mhc-icon-string (icon alt) (if (setq icon (assoc (downcase icon) elserv-mhc/icon-image-alist)) (concat "\""") alt)) (defun elserv-mhc-make-todo-list (day category-predicate secret) (let ((schedules (mhc-db-scan-todo day)) (mhc-tmp-day day) priority check deadline) (when schedules (insert (mhc-day-let day (format elserv-mhc-todo-title-format year month day-of-month))) (insert "") (dolist (schedule schedules) (when (and (if (mhc-schedule-in-category-p schedule "done") mhc-todo-display-done t) (funcall category-predicate schedule)) (setq priority (mhc-schedule-priority schedule) check (mhc-schedule-in-category-p schedule "done") deadline (mhc-schedule-todo-deadline schedule)) (insert "" (if (mhc-schedule-priority schedule) (format ""))) (insert "
%s" (elserv-mhc-string-with-face (format "[%d]" priority) (cond ((null priority) 'default) ((>= priority 80) 'mhc-summary-face-sunday) ((>= priority 50) 'mhc-summary-face-saturday)))) "")) (insert (if check (elserv-mhc-icon-string "done" "$B"#(B") (elserv-mhc-icon-string "todo" "$B""(B"))) (dolist (category (delete "todo" (delete "done" (copy-sequence (mhc-schedule-categories schedule))))) (when (and category (assoc (downcase category) elserv-mhc/icon-image-alist)) (insert (elserv-mhc-icon-string category "$B!{(B")))) (insert (elserv-mhc-string-with-face (or (mhc-schedule-subject schedule) "") (or (mhc-face-category-to-face (car (mhc-schedule-categories schedule))) 'default)) (elserv-mhc-string-with-face (or (mhc-schedule-location schedule) "") 'mhc-summary-face-location) (if (mhc-schedule-in-category-p schedule "done") "" (elserv-mhc-string-with-face (or (and deadline (if (mhc-date= deadline day) mhc-todo-string-deadline-day (let ((remaining (mhc-date- deadline day))) (if (> remaining 0) (format mhc-todo-string-remaining-day remaining) (format mhc-todo-string-excess-day (abs remaining)))))) "") (or (and deadline (if (> (mhc-date- deadline day) 0) 'mhc-summary-face-default 'mhc-summary-face-sunday)) 'default))) (if (mhc-record-name (mhc-schedule-record schedule)) (concat "" (if elserv-mhc-article-icon-image (concat "\"$B"*(B\"") "$B"*(B") "") "") "
")))) (defun elserv-mhc-face-foreground (face) "Return foreground color name of FACE." (static-if (fboundp 'face-foreground-name) (face-foreground-name face) (face-foreground face))) (defun elserv-mhc-face-background (face) "Return background color name of FACE." (static-if (fboundp 'face-background-name) (face-background-name face) (face-background face))) (defun elserv-mhc-string-with-face (string face) (concat "" string "")) (defun elserv-mhc-insert-dayinfo (dayinfo today category-predicate secret) (let* ((time-max -1) (schedules (mhc-day-schedules dayinfo)) day-face begin end priority next-begin conflict) (setq day-face (cond ((mhc-schedule-in-category-p (car schedules) "holiday") 'mhc-category-face-holiday) ((eq (mhc-day-day-of-week dayinfo) 0) 'mhc-summary-face-sunday) ((eq (mhc-day-day-of-week dayinfo) 6) 'mhc-summary-face-saturday) (t 'mhc-summary-face-default))) (if (mhc-date= (mhc-day-date dayinfo) (mhc-date-now)) (setq day-face (mhc-face-get-today-face day-face))) (insert (format "" elserv-mhc-calendar-cell-width elserv-mhc-calendar-cell-height) (elserv-mhc-string-with-face (number-to-string (mhc-day-day-of-month dayinfo)) day-face) "
") (while schedules (setq begin (mhc-schedule-time-begin (car schedules)) end (mhc-schedule-time-end (car schedules)) priority (mhc-schedule-priority (car schedules)) next-begin (if (car (cdr schedules)) (mhc-schedule-time-begin (car (cdr schedules)))) conflict (or (and end next-begin (< next-begin end)) (and begin time-max (< begin time-max)))) (insert (elserv-mhc-string-with-face (if begin (format "%02d:%02d" (/ begin 60) (% begin 60)) "") 'default) (elserv-mhc-string-with-face (if end (format "-%02d:%02d" (/ end 60) (% end 60)) "") 'default) (if conflict (elserv-mhc-icon-string "conflict" "$B"((B") "")) (dolist (category (if (mhc-schedule-in-category-p (car schedules) "done") (delete "todo" (copy-sequence (mhc-schedule-categories (car schedules)))) (mhc-schedule-categories (car schedules)))) (insert (elserv-mhc-icon-string category "$B!{(B"))) (insert (elserv-mhc-string-with-face (or (mhc-schedule-subject (car schedules)) "") (mhc-face-category-to-face (car (mhc-schedule-categories (car schedules))))) (if (and (mhc-schedule-location (car schedules)) (> (length (mhc-schedule-location (car schedules))) 0)) (elserv-mhc-string-with-face (concat "[" (mhc-schedule-location (car schedules)) "]") 'mhc-summary-face-location) "") (elserv-mhc-string-with-face (if priority (format "(%d)" priority) "") 'default) (if (mhc-record-name (mhc-schedule-record (car schedules))) (concat "" (if elserv-mhc-article-icon-image (concat "\"$B"*(B\"") "$B"*(B") "") "") "
") (setq schedules (cdr schedules))) (insert ""))) (defun elserv-mhc-make-calendar (from to today category-predicate secret) (let ((count 0)) (dolist (dayinfo (mhc-db-scan from to)) (when (zerop (% count 7)) (insert "")) (elserv-mhc-insert-dayinfo dayinfo today category-predicate secret) (when (zerop (% (incf count) 7)) (insert ""))))) (defun elserv-mhc-article-function (result path ppath request) (let (raw-buffer mime-view-ignored-field-list charset) (with-temp-buffer (insert-file-contents-as-binary (expand-file-name (concat "schedule" path) mhc-mail-path)) (setq raw-buffer (current-buffer)) (with-temp-buffer (mime-view-buffer raw-buffer (current-buffer)) (setq charset (detect-mime-charset-region (point-min)(point-max))) (elserv-set-result-header result (list 'content-type (concat "text/plain; charset=" (symbol-name charset)))) (elserv-set-result-body result (encode-mime-charset-string (buffer-string) charset)))))) (defun elserv-mhc-function (result path ppath request) (with-temp-buffer (let ((month (or (if (plist-get request 'body) (cdr (assoc "month" (elserv-url-decode (plist-get request 'body)))) path))) charset) (if (and (not (eq (length month) 0)) (eq (aref month 0) ?/)) (setq month (substring month 1))) (if (<= (length month) 1) (setq month (mhc-date-now)) (setq month (apply (lambda (x y z) (mhc-date-new x y z)) (nconc (mapcar 'string-to-number (split-string month "/")) (list 1))))) (elserv-mhc-month month) (setq charset (detect-mime-charset-region (point-min)(point-max))) (elserv-set-result-header result (list 'content-type (concat "text/html; charset=" (symbol-name charset)))) (elserv-set-result-body result (encode-mime-charset-string (buffer-string) charset))))) (defun elserv-mhc-month (month) (elserv-mhc-content month mhc-default-category-predicate-sexp 'secret)) (defun elserv-mhc-path (day) (expand-file-name (format "%d/%d" (mhc-date-yy day) (mhc-date-mm day)) elserv-mhc/path)) (defun elserv-mhc-content (date predicate secret) (let ((from (mhc-date-mm-first date)) (to (mhc-date-mm-last date)) (today (mhc-date-now))) (insert "
") (elserv-mhc-make-todo-list today predicate secret) (setq from (mhc-date- from (mhc-date-ww from))) (setq to (mhc-date+ to (- 6 (mhc-date-ww to)))) (insert (format elserv-mhc-calendar-title-format (mhc-date-yy date) (mhc-date-mm date))) (insert " [prev] " " [today] " " [next] ") (insert "" "" "" "" "" "" "" "" "" "") (elserv-mhc-make-calendar from to today mhc-default-category-predicate-sexp secret) (insert "
$BF|(B$B7n(B$B2P(B$B?e(B$BLZ(B$B6b(B$BEZ(B
Powered by " (elserv-version) ""))) (defun elserv-mhc-icon-setup (process path) (setq elserv-mhc/icon-image-alist (mapcar (lambda (x) (cons (downcase (car x)) (cdr x))) elserv-mhc-icon-image-alist))) (defun elserv-mhc-publish (process path) "Publish MHC service. PROCESS is the elserv server process. PATH is the path to publish MHC content." (mhc-face-setup) (setq elserv-mhc/path path) (elserv-publish process path :function 'elserv-mhc-function :description "MHC Calendar") (elserv-publish process (expand-file-name "schedule" path) :function 'elserv-mhc-article-function) (elserv-mhc-icon-setup process path) (elserv-mhc-publish-image process path "background" elserv-mhc-background-image) (elserv-mhc-publish-image process path "article" elserv-mhc-article-icon-image)) (defun elserv-mhc-start (&optional port) "Start MHC server on PORT." (interactive (if current-prefix-arg (list (string-to-number (read-from-minibuffer "Port: "))))) (elserv-mhc-publish (elserv-start (or port elserv-mhc-default-port)) "/") (message "Access 'http://%s:%d/' to get your schedule." (system-name) (or port elserv-mhc-default-port))) (require 'product) (product-provide (provide 'es-mhc) (require 'elserv)) ;;; es-mhc.el ends here elserv-0.4.0+0.20011203cvs/es-monitor.el0100644000175000017500000000613107331404612015263 0ustar bg66bg66;;; es-monitor.el -- Elserv monitor. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; ;;; Code: (require 'mcharset) (require 'elserv) (defun elserv-monitor-function (result path ppath request) (unless (or (eq (length path) 0) (string= path "/")) (signal 'elserv-forbidden (concat "Access to " path " is not allowed."))) (let (paths content charset) (mapatoms (lambda (x) (setq paths (cons (cons (symbol-name x) (symbol-value x)) paths))) elserv-buffer-publish-hash) (with-temp-buffer (setq paths (sort paths (lambda (x y) (string< (car x) (car y))))) (insert "Elserv Monitor\n" "

Elserv Monitor

\n" "" "\n") (dolist (exp paths) (setq content (concat content (if (or (not (eq (car (cdr exp)) 'elserv-service-function)) (nth 1 (cdr exp))) (concat "")) ((eq (car (cdr exp)) 'elserv-service-directory) (concat (nth 1 (cdr exp)) "(Directory)")) ((eq (car (cdr exp)) 'elserv-service-string) (concat (nth 1 (cdr exp)) "(String)")))))))) (insert content "
PathContent DescriptionType
" "" (car exp) "" "" (cond ((eq (car (cdr exp)) 'elserv-service-function) (concat (nth 1 (cdr exp)) " (Function: " (symbol-name (nth 4 (cdr exp))) ")" (or (nth 5 (cdr exp)) "-") "
-
" (nth 5 (cdr exp)) "
" "
Powered by " (elserv-version) "") (setq charset (detect-mime-charset-region (point-min)(point-max))) (elserv-set-result-header result (list 'content-type (concat "text/html; charset=" (symbol-name charset)))) (elserv-set-result-body result (encode-mime-charset-string (buffer-string) charset))))) (defun elserv-monitor-publish (process path) "Publish Monitor. PROCESS is the elserv server process. PATH is the path to publish Wiki content." (elserv-publish process path :function 'elserv-monitor-function :description "Elserv Monitor")) (provide 'es-monitor) ;;; es-monitor.el ends here elserv-0.4.0+0.20011203cvs/es-wiki.el0100644000175000017500000002354507325156600014553 0ustar bg66bg66;;; es-wiki.el -- Elserv interface for emacs-wiki. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; ;;; Code: (require 'emacs-wiki) (require 'elserv) ;; Set action as relative path! (defvar elserv-wiki-http-edit-form "
\n") (defvar elserv-wiki-http-search-form "
Search for:
\n") (defvar elserv-wiki-publishing-footer "
(if buffer-file-name (concat \"Updated: \" (format-time-string emacs-wiki-footer-date-format (nth 5 (file-attributes buffer-file-name))) (and emacs-wiki-serving-p (emacs-wiki-editable-p (emacs-wiki-page-name)) (concat \" / \" (emacs-wiki-link-href (concat \"editwiki?\" (emacs-wiki-page-name)) \"Edit\"))))) (concat (and (emacs-wiki-page-file emacs-wiki-home-page t) (not (emacs-wiki-private-p emacs-wiki-home-page)) (concat (emacs-wiki-link-href emacs-wiki-home-page \"Home\") \" / \")) (emacs-wiki-link-href emacs-wiki-index-page \"Index\") (and (emacs-wiki-page-file \"ChangeLog\" t) (not (emacs-wiki-private-p \"ChangeLog\")) (concat \" / \" (emacs-wiki-link-href \"ChangeLog\" \"Changes\")))) (if emacs-wiki-serving-p (concat (emacs-wiki-link-href \"searchwiki?get\" \"Search\") (and buffer-file-name (concat \" / \" (emacs-wiki-link-href (concat \"searchwiki?q=\" (emacs-wiki-page-name)) \"Referrers\")))))
Powered by (elserv-version t)
\n") (defun elserv-wiki-interwiki-page () (if emacs-wiki-interwiki-names (concat "- [[" (mapconcat 'car emacs-wiki-interwiki-names "]]\n- [[") "]]\n") "No WikiNames")) (defun elserv-wiki-render-page (result name) (cond ((string= name emacs-wiki-index-page) (with-current-buffer (emacs-wiki-generate-index t t) (emacs-wiki-replace-markup "Wiki Index") (elserv-set-result-header result (list 'content-type "text/html; charset=iso-2022-jp")) (elserv-set-result-body result (encode-coding-string (buffer-string) 'iso-2022-jp)) (kill-buffer (current-buffer)))) ((string= name "WikiNames") (with-temp-buffer (insert (elserv-wiki-interwiki-page)) (emacs-wiki-replace-markup "WikiNames") (elserv-set-result-header result (list 'content-type "text/html")) (elserv-set-result-body result (buffer-string)))) (t (let ((file (and (not (emacs-wiki-private-p name)) (cdr (assoc name (emacs-wiki-file-alist))))) (system-time-locale "C") (inhibit-read-only t)) (if (null file) (signal 'elserv-file-not-found (concat "Page not found" (format "Wiki page %s not found" name))) (with-temp-buffer (let ((modified-time (nth 5 (file-attributes file)))) (insert-file-contents-as-binary file) (decode-coding-region (point-min) (point-max) 'iso-2022-jp) (setq buffer-file-name name) (emacs-wiki-replace-markup name) (set-buffer-modified-p nil) (elserv-set-result-header result (list 'content-type "text/html; charset=iso-2022-jp" 'last-modified (format-time-string "%a, %e %b %Y %T %Z" modified-time))) (elserv-set-result-body result (encode-coding-string (buffer-string) 'iso-2022-jp))))))))) (defun elserv-wiki-edit-page (result page-name) (let ((emacs-wiki-http-edit-form elserv-wiki-http-edit-form)) (if (not (emacs-wiki-editable-p page-name)) (signal 'elserv-forbidden "Editing this Wiki page is not allowed") (with-temp-buffer (emacs-wiki-setup-edit-page page-name) ;; this is required because of the : in the name (elserv-set-result-header result (list 'content-type "text/html; charset=iso-2022-jp")) (elserv-set-result-body result (encode-coding-string (buffer-string) 'iso-2022-jp)))))) (defun elserv-wiki-change-page (result request) (let* ((res (elserv-url-decode (plist-get request 'body))) (page (caar res)) (text (cdar res)) (len (length text)) (require-final-newline t) (pos 0) illegal user) (if (not (emacs-wiki-editable-p page)) (signal 'elserv-forbidden (format "Editing Wiki page %s is not allowed" page))) (while (and (null illegal) (setq pos (string-match "<\\s-*\\([^> \t]+\\)" text pos))) (setq pos (match-end 0)) (if (assoc (match-string 1 text) emacs-wiki-dangerous-tags) (setq illegal (match-string 1 text)))) (if illegal (signal 'elserv-forbidden (format "Public use of <%s> tag not allowed" illegal))) (emacs-wiki-find-file page) (if (setq user (file-locked-p buffer-file-name)) (signal 'elserv-forbidden (format "The page \"%s\" is currently being edited by %s." page (if (eq user t) (user-full-name) user)))) (let ((inhibit-read-only t) (delete-old-versions t)) (erase-buffer) (insert (if (eq (aref text (1- len)) ?%) (substring text 0 (1- len)) text)) (goto-char (point-min)) (while (re-search-forward "\r$" nil t) (replace-match "" t t)) (save-buffer) (if (/= (file-modes buffer-file-name) ?\666) (set-file-modes buffer-file-name ?\666)) (kill-buffer (current-buffer))) (with-temp-buffer (emacs-wiki-file-alist) ; force re-check (insert "") (insert "Thank you, your changes have been saved to " page) (insert ". You will be redirected to " "the new page in a moment.") (insert "") (emacs-wiki-replace-markup "Change Saved") (elserv-set-result-header result '(content-type "text/html")) (elserv-set-result-body result (buffer-string))))) (defun elserv-wiki-search-input-page (result) (let ((emacs-wiki-http-search-form elserv-wiki-http-search-form)) (with-temp-buffer (insert "" emacs-wiki-http-search-form "") (emacs-wiki-replace-markup "Search Wiki Pages") (elserv-set-result-header result (list 'content-type "text/html")) (elserv-set-result-body result (buffer-string))))) (defun elserv-wiki-search-page (result term) (let ((compilation-scroll-output nil)) (with-current-buffer (emacs-wiki-grep term) (emacs-wiki-wikify-search-results term) (emacs-wiki-replace-markup "Search Results") (elserv-set-result-header result (list 'content-type "text/html;charset=iso-2022-jp")) (elserv-set-result-body result (encode-coding-string (buffer-string) 'iso-2022-jp)) (kill-buffer (current-buffer))))) (defun elserv-wiki-function (result path ppath request) (if (string= path "") (elserv-make-redirect result (concat "http://" (plist-get request 'host) (unless (string= ppath "/") ppath) path "/")) (let ((emacs-wiki-serving-p t) (emacs-wiki-publishing-footer elserv-wiki-publishing-footer)) (cond ((string= path "/") ; default page. (elserv-wiki-render-page result emacs-wiki-default-page)) ((string-match "\\`/wiki\\?\\(.+\\)" path) (elserv-wiki-render-page result (match-string 1 path))) ((string-match "\\`/editwiki\\?\\(.+\\)" path) (elserv-wiki-edit-page result (match-string 1 path))) ((string-match "\\`/changewiki\\?post" path) (elserv-wiki-change-page result request)) ((string-match "\\`/searchwiki\\?get" path) (elserv-wiki-search-input-page result)) ((string-match "\\`/searchwiki\\?q=\\(.+\\)" path) (elserv-wiki-search-page result (match-string 1 path))) (t (signal 'elserv-file-not-found "Specified Wiki page was not found.")))))) (defun elserv-wiki-publish (process path) "Publish Wiki service. PROCESS is the elserv server process. PATH is the path to publish Wiki content." (elserv-publish process path :function 'elserv-wiki-function :description "Emacs Wiki.")) (defun elserv-wiki-start (&optional port) "Start a Wiki Server." (interactive (if current-prefix-arg (list (string-to-number (read-from-minibuffer "Port: "))))) (elserv-publish (elserv-start port) "/" :function 'elserv-wiki-function)) (require 'product) (product-provide (provide 'es-wiki) (require 'elserv)) ;;; es-wiki.el ends here elserv-0.4.0+0.20011203cvs/es-xmlrpc.el0100644000175000017500000000313307330236013015075 0ustar bg66bg66;;; es-xmlrpc.el -- Elserv interface for XML-RPC. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: HTTP, XML-RPC ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;;; Code: (require 'elserv) (require 'elserv-xmlrpc) (defun elserv-xmlrpc-function (result path ppath request) (elserv-set-result-header result (list 'content-type "text/xml")) (elserv-set-result-body result (elserv-xmlrpc-process-request (plist-get request 'body)))) (defun elserv-xmlrpc-publish (process path) "Publish XML-RPC service. PROCESS is the elserv server process. PATH is the path to publish XML-RPC content." (elserv-xmlrpc-register-defaults) (elserv-publish process path :function 'elserv-xmlrpc-function :description "XML-RPC service")) (require 'product) (product-provide (provide 'es-xmlrpc) (require 'elserv)) ;;; es-xmlrpc.el ends here elserv-0.4.0+0.20011203cvs/remote.el0100644000175000017500000001312007323217667014473 0ustar bg66bg66;;; remote.el -- Emacs remote controller. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: Remote Controll, WWW ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; This program requires Elserv -- Yet another HTTP server on Emacsen ;; which is available at: http://www.gohome.org/elserv/ ;; Please install it first. ;;; History: ;; (require 'elserv) ;;; Code: (defvar remote-controller-command-page-body "

Emacs $B%j%b%3%s(B

$B%3%^%s%I(B:
" "Page body of /command.") (defvar remote-controller-key-page-body "

Emacs $B%j%b%3%s(B

$B%-!
" "Page body of /key.") (defvar remote-controller-eval-page-body "

Emacs $B%j%b%3%s(B

eval:


" "Page body of /eval.") (defvar remote-controller-default-port 8001) (defun remote-controller-function (result path ppath request) "Elserv publish function. RESULT, PATH, PPATH and REQUEST are given arguments." (let ((body (elserv-url-decode (plist-get request 'body))) data message) (when body (with-current-buffer (window-buffer (selected-window)) (cond ((and (setq data (cdr (assoc "command" body))) (> (length data) 0)) (call-interactively (intern data))) ((and (setq data (cdr (assoc "key" body))) (> (length data) 0)) (let ((binding (or (lookup-key (current-local-map) data t) (lookup-key global-map data t)))) (if (and binding (not (numberp binding))) (if (eq binding 'self-insert-command) (insert data) (call-interactively binding)) (setq message (format "key `%s' is not bound." data))))) ((and (setq data (cdr (assoc "eval" body))) (> (length data) 0)) (if (setq message (eval (read data))) (setq message (prin1-to-string message))))))) (elserv-set-result-header result '(content-type "text/html; charset=\"iso-2022-jp\"")) (elserv-set-result-body result (encode-coding-string (concat "Remote Controller" (symbol-value (intern (format "remote-controller-%s-page-body" (substring (if (string= ppath "/") "/command" ppath) 1)))) "$B%3%^%s%I(B $B%-! eval $B%P%C%U%!0lMw(B
" message "") 'iso-2022-jp)))) ;; Original is elserv-demo-buffers (defun remote-controller-buffers (result path ppath request) "Elserv publish function. RESULT, PATH, PPATH and REQUEST are given arguments." (let ((buf (and (not (string= path "")) (get-buffer (substring path 1))))) (if buf (progn (elserv-set-result-header result '(content-type "text/plain")) (elserv-set-result-body result (with-current-buffer buf (encode-coding-string (buffer-string) 'iso-2022-jp)))) (elserv-set-result-header result '(content-type "text/html; charset=iso-2022-jp")) (elserv-set-result-body result (concat (encode-coding-string "

Emacs $B%j%b%3%s(B

$B%P%C%U%!0lMw(B
    " 'iso-2022-jp) (mapconcat (function (lambda (buf) (let ((name (buffer-name buf))) (unless (string= (substring name 0 1) " ") (concat "
  • " name "\n"))))) (buffer-list) "") (encode-coding-string "

$B%3%^%s%I(B $B%-! eval $B%P%C%U%!0lMw(B" 'iso-2022-jp )))))) (defun remote-controller (&optional port) "Start remote controller. Optional argument PORT is used as port number for the remote controller." (interactive (if current-prefix-arg (list (string-to-number (read-from-minibuffer "Port: "))))) (elserv-start (or port remote-controller-default-port)) (elserv-publish (elserv-find-process) "/" :function 'remote-controller-function) (elserv-publish (elserv-find-process) "/key" :function 'remote-controller-function) (elserv-publish (elserv-find-process) "/eval" :function 'remote-controller-function) (elserv-publish (elserv-find-process) "/buffers" :function 'remote-controller-buffers) (message "Access 'http://%s:%d/' to controll this Emacs!" (system-name) (or port remote-controller-default-port))) (provide 'remote) ;;; remote.el ends here elserv-0.4.0+0.20011203cvs/web-custom.el0100644000175000017500000001502507324730751015266 0ustar bg66bg66;;; web-custom.el -- Customization via web browser. ;; Copyright (C) 2001 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: Customize, WWW ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; ;;; Commentary: ;; This program requires Elserv -- Yet another HTTP server on Emacsen ;; which is available at: http://www.gohome.org/elserv/ ;; Please install it first. ;;; History: ;; (require 'elserv) (require 'custom) (require 'cus-edit) (require 'mcharset) ;;; Code: (defvar web-custom-default-port 8080 "*Default port for web custom.") (defun web-custom-group-body (group) (let ((members (custom-group-members group nil))) (concat "

group " (symbol-name group) "

" (mapconcat (lambda (member) (if (eq (nth 1 member) 'custom-group) (web-custom-group-body (car member)) (web-custom-option-body (car member)))) members "")))) (defun web-custom-option-body (option) (let* ((type (custom-variable-type option)) (ptype (car type))) (concat "

" (symbol-name option) "

" "
"
	    (when (boundp option)
	      (if (eq (string-to-char
		       (documentation-property option 'variable-documentation))
		      ?*)
		  (substring
		   (documentation-property option 'variable-documentation) 1)
		(documentation-property option 'variable-documentation)))
	    "
" "" (cond ((or (eq ptype 'string) (eq ptype 'regexp) (eq ptype 'integer) (eq ptype 'symbol) (eq ptype 'file) (eq ptype 'directory) (eq ptype 'coding-system)) (concat (symbol-name ptype) ": " "")) ((eq ptype 'boolean) (concat "")) ((eq ptype 'face) ; ignore.. "cannot customize. sorry.") (t (concat (prin1-to-string type) ":
" ""))) ""))) (defun web-custom-function (result path ppath request) (let (charset) (with-temp-buffer (insert "Customize" (web-custom-group-body (intern (if (plist-get request 'body) (cdr (assoc "group" (elserv-url-decode (plist-get request 'body)))) (substring path 1)))) "") (setq charset (detect-mime-charset-region (point-min)(point-max))) (elserv-set-result-header result (list 'content-type (concat "text/html; charset=" (symbol-name charset)))) (elserv-set-result-body result (encode-mime-charset-string (buffer-string) charset))))) (defun web-custom-set-function (result path ppath request) (let ((options (elserv-url-decode (plist-get request 'body))) charset type value) (with-temp-buffer (insert "Customization Completed") (dolist (option options) (when (string-match "^\\([^:]+\\):\\(.*\\)$" (car option)) (setq type (intern (substring (car option) 0 (match-end 1)))) (setcar option (substring (car option) (match-beginning 2)))) (setcdr option (decode-coding-string (cdr option) 'undecided)) (cond ((eq type 'integer) (setq value (string-to-number (cdr option)))) ((eq type 'boolean) (setq value (string= "ON" (cdr option)))) ((eq type 'sexp) (setq value (read (cdr option)))) ((or (eq type 'coding-system)(eq type 'symbol)) (setq value (intern (cdr option)))) (t (setq value (cdr option)))) ;; Set actual value! (set (intern (car option)) value) (insert "Value of `" (car option) "' is set as:
" "
")
	(pp value (current-buffer))
	(insert "
")) (insert "top") (setq charset (detect-mime-charset-region (point-min)(point-max))) (elserv-set-result-header result (list 'content-type (concat "text/html; charset=" (symbol-name charset)))) (elserv-set-result-body result (encode-mime-charset-string (buffer-string) charset))))) (defun web-custom (&optional port) (interactive (if current-prefix-arg (list (string-to-number (read-from-minibuffer "Port: "))))) (elserv-start (or port web-custom-default-port)) (elserv-publish (elserv-find-process) "/group" :function 'web-custom-function) (elserv-publish (elserv-find-process) "/set" :function 'web-custom-set-function) (elserv-publish (elserv-find-process 8080) "/" :function (lambda (result path ppath request) (elserv-set-result-header result '(content-type "text/html")) (elserv-set-result-body result (concat "Customize" "

Customize

" "
" "group:
" "
" "")))) (message "Access 'http://%s:%d/' to customize." (system-name) (or port web-custom-default-port))) (provide 'web-custom) ;;; web-custom.el ends here elserv-0.4.0+0.20011203cvs/xml-rpc.el0100644000175000017500000003512607330237304014560 0ustar bg66bg66;; xml-rpc.el -- An elisp implementation of clientside XML-RPC ;; $Id: xml-rpc.el,v 1.2 2001/07/27 10:13:24 teranisi Exp $ ;; Copyright (C) 2001 CodeFactory AB. ;; Copyright (C) 2001 Daniel Lundin. ;; Author: Daniel Lundin ;; Maintainer: Daniel Lundin ;; Version: 1.0 ;; Created: May 13 2001 ;; Keywords: xml rpc network ;; URL: http://www.codefactory.se/~daniel/emacs/ ;; This file is NOT (yet) part of GNU Emacs. ;; This is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This software is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This is an XML-RPC client implementation in elisp, capable of both ;; synchronous and asynchronous method calls (using the url package's async ;; retrieval functionality). ;; XML-RPC is remote procedure calls over HTTP using XML to describe the ;; function call and return values. ;; xml-rpc.el represents XML-RPC datatypes as lisp values, automatically ;; converting to and from the XML datastructures as needed, both for method ;; parameters and return values, making using XML-RPC methods fairly ;; transparent to the lisp code. ;; Requirements ;; ------------ ;; xml-rpc.el uses the url package for http handling and xml.el for XML ;; parsing. url is a part of the W3 browser package (but now as a separate ;; module in the CVS repository). ;; xml.el is a part of GNU Emacs 21, but can also be downloaded from ;; here: ;; XML-RPC datatypes are represented as follows ;; -------------------------------------------- ;; int: 42 ;; float/double: 42.0 ;; string: "foo" ;; array: '(1 2 3 4) '(1 2 3 (4.1 4.2)) ;; struct: '(("name" . "daniel") ("height" . 6.1)) ;; Examples ;; ======== ;; Here follows some examples demonstrating the use of xml-rpc.el ;; Normal synchronous operation ;; ---------------------------- ;; (xml-rpc-method-call "http://localhost:80/RPC" 'foo-method foo bar zoo) ;; Asynchronous example (cb-foo will be called when the methods returns) ;; --------------------------------------------------------------------- ;; (defun cb-foo (foo) ;; (print (format "%s" foo))) ;; (xml-rpc-method-call-async 'cb-foo "http://localhost:80/RPC" ;; 'foo-method foo bar zoo) ;; Some real world working examples for fun and play ;; ------------------------------------------------- ;; Check the temperature (celsius) outside jonas@codefactory.se's apartment ;; (xml-rpc-method-call ;; "http://flint.bengburken.net:80/xmlrpc/onewire_temp.php" ;; 'onewire.getTemp) ;; Fetch the latest NetBSD news the past 5 days from O'reillynet ;; (xml-rpc-method-call "http://www.oreillynet.com/meerkat/xml-rpc/server.php" ;; 'meerkat.getItems ;; '(("channel" . 1024) ;; ("search" . "/NetBSD/") ;; ("time_period" . "5DAY") ;; ("ids" . 0) ;; ("descriptions" . 200) ;; ("categories" . 0) ;; ("channels" . 0) ;; ("dates" . 0) ;; ("num_items" . 5))) ;;; History: ;; 1.0 - First version ;; 26 Jul 2001 Modified by Yuuichi Teranishi. ;; ;; * Added emacs-w3m implementation. ;; * Treat coding system for XML response. ;; * Added i4 and dateTime.iso8601 data type. ;;; Bugs/Todo: ;; * Base64 datatype is not implemented [should use base64.el] ;;; Code: (require 'custom) (require 'xml) (condition-case nil (progn (require 'w3m) (require 'url)) (error)) (defcustom xml-rpc-load-hook nil "*Hook run after loading xml-rpc." :type 'hook :group 'xml-rpc) (defmacro xml-rpc-static-if (cond then &rest else) "`if' expression but COND is evaluated at compile-time." (if (eval cond) then (` (progn (,@ else))))) ;; ;; Value type handling functions ;; (defun xml-rpc-value-intp (value) "Return t if VALUE is an integer." (integerp value)) (defun xml-rpc-value-doublep (value) "Return t if VALUE is a double precision number." (floatp value)) (defun xml-rpc-value-stringp (value) "Return t if VALUE is a double precision number." (stringp value)) ;; An XML-RPC struct is a list where every car is a list of length 1 or 2 and ;; has a string for car. (defsubst xml-rpc-value-structp (value) "Return t if VALUE is an XML-RPC struct." (and (listp value) (let ((vals value) (result t) curval) (while (and vals result) (setq result (and (setq curval (car-safe vals)) (cdr-safe curval) ; (memq (safe-length curval) '(1 2)) (stringp (car-safe curval)))) (setq vals (cdr-safe vals))) result))) ;; A somewhat lazy predicate for arrays (defsubst xml-rpc-value-arrayp (value) "Return t if VALUE is an XML-RPC struct." (and (listp value) (not (xml-rpc-value-structp value)))) (defun xml-rpc-xml-list-to-value (xml-list) "Convert an XML-RPC structure in an xml.el style XML-LIST to an elisp list, \ interpreting and simplifying it while retaining its structure." (let ((valtype (car (caddar xml-list))) (valvalue (caddr (caddar xml-list)))) (cond ;; Base64 not implemented yet ((eq valtype 'base64) (error "Base64 handling not implemented yet")) ;; String ((eq valtype 'string) valvalue) ;; Integer ((or (eq valtype 'int) (eq valtype 'i4)) (string-to-int valvalue)) ;; dateTime ((eq valtype 'dateTime.iso8601) valvalue) ;; Double/float ((eq valtype 'double) (string-to-number valvalue)) ;; Struct ((eq valtype 'struct) (mapcar (lambda (member) (let ((membername (cadr (cdaddr member))) (membervalue (xml-rpc-xml-list-to-value (cdddr member)))) (cons membername membervalue))) (cddr (caddar xml-list)))) ;; Array ((eq valtype 'array) (mapcar (lambda (arrval) (xml-rpc-xml-list-to-value (list arrval))) (cddr valvalue)))))) (defun xml-rpc-value-to-xml-list (value) "Return XML representation of VALUE properly formatted for use with the \ functions in xml.el." (cond ((not value) nil) ((listp value) (let ((result nil) (xmlval nil)) (if (xml-rpc-value-structp value) ;; Value is a struct (progn (while (setq xmlval `((member nil (name nil ,(caar value)) ,(car (xml-rpc-value-to-xml-list (cdar value))))) result (if t (append result xmlval) (car xmlval)) value (cdr value))) `((value nil ,(append '(struct nil) result)))) ;; Value is an array (while (setq xmlval (xml-rpc-value-to-xml-list (car value)) result (if result (append result xmlval) xmlval) value (cdr value))) `((value nil (array nil ,(append '(data nil) result))))))) ;; Value is a scalar ((xml-rpc-value-intp value) `((value nil (int nil ,(int-to-string value))))) ((xml-rpc-value-stringp value) `((value nil (string nil ,value)))) ((xml-rpc-value-doublep value) `((value nil (double nil ,(number-to-string value))))))) (defun xml-rpc-xml-to-string (xml &optional coding) "Return a string representation of the XML tree as valid XML markup." (let ((tree (xml-node-children xml)) (result (concat "<" (symbol-name (xml-node-name xml)) ">"))) (while tree (cond ((listp (car tree)) (setq result (concat result (xml-rpc-xml-to-string (car tree) coding)))) ((stringp (car tree)) (setq result (concat result (car tree))) (if coding (setq result (encode-coding-string result coding)))) (t (error "Invalid XML tree"))) (setq tree (cdr tree))) (setq result (concat result "")) result)) ;; ;; Response handling ;; (defsubst xml-rpc-response-errorp (response) "An 'xml-rpc-method-call' result value is always a list, where the first \ element in RESPONSE is either nil or if an error occured, a cons pair \ according to (errnum . \"Error string\")," (let ((first (car-safe response))) (and first (listp first) (eq (car first) 'fault)))) (defsubst xml-rpc-response-error-code (response) "Return the error code from RESPONSE." (and (xml-rpc-response-errorp response) (caar response))) (defsubst xml-rpc-response-error-string (response) "Return the error code from RESPONSE." (and (xml-rpc-response-errorp response) (cdar response))) (defun xml-rpc-xml-to-response (xml) "Convert an XML list to a method response list. The return value is always a list with two elements, (error payload). Error is either nil or a cons pair consisting of and integer errorcode and error description string. The errorcode is nil if XML is not a valid xml list. Payload is an rpc-xml-value." ;; Check if we have a methodResponse (cond ((not (eq (car-safe (car-safe xml)) 'methodResponse)) '((nil . "Not a valid XML-RPC methodResponse."))) ;; Did we get a fault response ((eq (caaddr (car xml)) 'fault) ;; Dig deep in the XML list for some useful information (let ((errstruct (cddar (cddadr (cdaddr (car xml))))) errnum errstr) (setq errnum (string-to-number (caddr (caddar (cdddar errstruct)))) errstr (caddar (cddadr (cddadr errstruct)))) (list (cons errnum errstr) nil))) ;; Interpret the XML list and produce a more useful data structure (t (let ((valpart (cdr (cdaddr (caddar xml))))) (xml-rpc-xml-list-to-value valpart))))) ;; ;; Misc ;; (defun xml-rpc-get-temp-buffer-name () "Get a working buffer name such as ` *XML-RPC-*' without a live process \ and empty it" (let ((num 1) name buf) (while (progn (setq name (format " *XML-RPC-%d*" num) buf (get-buffer name)) (and buf (or (get-buffer-process buf) (save-excursion (set-buffer buf) (> (point-max) 1))))) (setq num (1+ num))) name)) ;; ;; Method handling ;; (xml-rpc-static-if (featurep 'w3m) (progn ;; w3m implementation. (defun xml-rpc-request (server-url xml &optional async-callback-function) (if async-callback-function (error "Asynchronous invocation is not supported yet.")) (if (w3m-retrieve server-url 'no-decode 'no-cache (cons "text/xml" (concat "\n" (xml-rpc-xml-to-string (car xml))))) (w3m-with-work-buffer (xml-rpc-request-process-buffer (current-buffer))))) (defun xml-rpc-request-process-buffer (xml-buffer) "Process buffer XML-BUFFER." (with-current-buffer xml-buffer (goto-char (point-min)) (if (looking-at "<\\?xml *version=.*\\??>") (xml-parse-region 0 (point-max))))) ;; end of w3m implementation. ) ;; w3 implementation. (defun xml-rpc-request (server-url xml &optional async-callback-function) "Perform http post request to SERVER-URL using XML. If ASYNC-CALLBACK-FUNCTION is non-nil, the request will be performed asynchronously and ASYNC-CALLBACK-FUNCTION should be a callback function to be called when the reuest is finished. ASYNC-CALLBACK-FUNCTION is called with a single argument being an xml.el style XML list. It returns an XML list containing the method response from the XML-RPC server, or nil if called with ASYNC-CALLBACK-FUNCTION." (unwind-protect (save-excursion (let ((url-working-buffer (get-buffer-create (xml-rpc-get-temp-buffer-name))) (url-request-method "POST") (url-package-name "Lispmeralda-Emacs") (url-package-version "1.0") (url-request-data (concat "\n" (xml-rpc-xml-to-string (car xml)))) (url-request-extra-headers (cons (cons "Content-Type" "text/xml") url-request-extra-headers))) (set-buffer url-working-buffer) ;; Set up asynchronous callback if requested (if async-callback-function (setq url-be-asynchronous t url-current-callback-data (list async-callback-function (current-buffer)) url-current-callback-func 'xml-rpc-request-callback-handler) (setq url-be-asynchronous nil)) (url-retrieve server-url t) (if url-be-asynchronous nil (let ((result (xml-rpc-request-process-buffer url-working-buffer))) (kill-buffer (current-buffer)) result)))))) (defun xml-rpc-request-process-buffer (xml-buffer) "Process buffer XML-BUFFER." (unwind-protect (save-excursion (set-buffer xml-buffer) (beginning-of-buffer) ;; Gather the results (let* ((status (cdr (assoc "status" url-current-mime-headers))) (result (cond ;; No HTTP status returned ((not status) (let ((errstart (search-forward "\n---- Error was: ----\n"))) (and errstart (buffer-substring errstart (point-max))))) ;; A probable XML response ((looking-at "<\\?xml *version=.*\\??>") (xml-parse-region 0 (point-max))) ;; Valid HTTP status (t (int-to-string status))))) result)))) (defun xml-rpc-request-callback-handler (callback-fun xml-buffer) "Marshall a callback function request to CALLBACK-FUN with the results \ handled from XML-BUFFER." (let ((xml-response (xml-rpc-request-process-buffer xml-buffer))) (kill-buffer xml-buffer) (funcall callback-fun (xml-rpc-xml-to-response xml-response)))) ;; end of w3 implementation. ) (defun xml-rpc-method-call-async (async-callback-func server-url method &rest params) "Call an XML-RPC method asynchronously at SERVER-URL named METHOD with \ PARAMS as parameters. When the method returns, ASYNC-CALLBACK-FUNC will be \ called with the result as parameter." (let* ((m-name (if (stringp method) method (symbol-name method))) (m-params (mapcar '(lambda (p) `(param nil ,(car (xml-rpc-value-to-xml-list p)))) (if async-callback-func params (car-safe params)))) (m-func-call `((methodCall nil (methodName nil ,m-name) ,(append '(params nil) m-params))))) (xml-rpc-request server-url m-func-call async-callback-func))) (defun xml-rpc-method-call (server-url method &rest params) "Call an XML-RPC method at SERVER-URL named METHOD with PARAMS as \ parameters." (let ((response (xml-rpc-method-call-async nil server-url method params))) (if (stringp response) (list (cons nil (concat "URL/HTTP Error: " response))) (xml-rpc-xml-to-response response)))) (provide 'xml-rpc) (run-hooks 'xml-rpc-load-hook) ;;; xml-rpc.el ends here