12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574# 1 "src/lib/eliom_state.server.ml"(* Ocsigen
* http://www.ocsigen.org
* Copyright (C) 2007 Vincent Balat
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)openEliom_libopenLwt(* Expired session? *)typestate_status=Alive_state|Empty_state|Expired_stateletservice_state_status~scope?secure()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeintryignore(Eliommod_sersess.find_service_cookie_only~cookie_scope~secure_o:secure());Alive_statewith|Not_found->Empty_state|Eliom_common.Eliom_Session_expired->Expired_stateletvolatile_data_state_status~scope?secure()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeintryignore(Eliommod_datasess.find_data_cookie_only~cookie_scope~secure_o:secure());Alive_statewith|Not_found->Empty_state|Eliom_common.Eliom_Session_expired->Expired_stateletpersistent_data_state_status~scope?secure()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeincatch(fun()->Eliommod_persess.find_persistent_cookie_only~cookie_scope~secure_o:secure()>>=fun_->returnAlive_state)(function|Not_found->Lwt.returnEmpty_state|Eliom_common.Eliom_Session_expired->Lwt.returnExpired_state|e->faile)(************)(*
let get_default_service_session_timeout = Eliommod_timeouts.get_default_service_timeout
let set_default_service_session_timeout = Eliommod_timeouts.set_default_service_timeout
let get_default_volatile_data_session_timeout =
Eliommod_timeouts.get_default_data_timeout
let set_default_volatile_data_session_timeout =
Eliommod_timeouts.set_default_data_timeout
let set_default_volatile_session_timeout =
Eliommod_timeouts.set_default_volatile_timeout
let get_default_persistent_data_session_timeout =
Eliommod_timeouts.get_default_persistent_timeout
let set_default_persistent_data_session_timeout =
Eliommod_timeouts.set_default_persistent_timeout
*)letset_default_global_service_state_timeout~cookie_level?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_service_timeout"inEliommod_timeouts.set_default_global`Servicecookie_leveloverride_configfilefalsesitedatatimeoutletset_global_service_state_timeout~cookie_scope?secure?(recompute_expdates=false)?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_service_timeout"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.set_global~kind:`Service~cookie_scope~secure~recompute_expdatesoverride_configfilesitedatatimeoutletset_default_global_volatile_data_state_timeout~cookie_level?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_data_timeout"inEliommod_timeouts.set_default_global`Datacookie_leveloverride_configfilefalsesitedatatimeoutletset_global_volatile_data_state_timeout~cookie_scope?secure?(recompute_expdates=false)?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_data_timeout"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.set_global~kind:`Data~cookie_scope~secure~recompute_expdatesoverride_configfilesitedatatimeoutletset_global_volatile_state_timeout~cookie_scope?secure?(recompute_expdates=false)?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_volatile_timeouts"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.set_global~kind:`Service~cookie_scope~secure~recompute_expdatesoverride_configfilesitedatatimeout;Eliommod_timeouts.set_global~kind:`Data~cookie_scope~secure~recompute_expdatesoverride_configfilesitedatatimeoutletset_default_global_persistent_data_state_timeout~cookie_level?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_persistent_timeout"inEliommod_timeouts.set_default_global`Servicecookie_leveloverride_configfilefalsesitedatatimeoutletset_global_persistent_data_state_timeout~cookie_scope?secure?(recompute_expdates=false)?(override_configfile=false)timeout=letsitedata=Eliom_request_info.find_sitedata"set_global_persistent_timeout"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.set_global~kind:`Persistent~cookie_scope~secure~recompute_expdatesoverride_configfilesitedatatimeoutletget_global_service_state_timeout?secure~cookie_scope()=letsitedata=Eliom_request_info.find_sitedata"get_global_timeout"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.get_global~kind:`Service~cookie_scope~securesitedataletget_global_volatile_data_state_timeout?secure~cookie_scope()=letsitedata=Eliom_request_info.find_sitedata"get_global_timeout"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.get_global~kind:`Data~cookie_scope~securesitedataletget_global_persistent_data_state_timeout?secure~cookie_scope()=letsitedata=Eliom_request_info.find_sitedata"get_global_persistent_timeout"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_timeouts.get_global~kind:`Persistent~cookie_scope~securesitedata(* Now for current session *)letset_service_state_timeout~cookie_scope?securet=letc=Eliommod_sersess.find_or_create_service_cookie~cookie_scope~secure_o:secure()inlettor=c.Eliom_common.sc_timeoutinmatchtwith|None->tor:=Eliom_common.TNone|Somet->tor:=Eliom_common.TSometletset_volatile_data_state_timeout~cookie_scope?securet=letc=Eliommod_datasess.find_or_create_data_cookie~cookie_scope~secure_o:secure()inlettor=c.Eliom_common.dc_timeoutinmatchtwith|None->tor:=Eliom_common.TNone|Somet->tor:=Eliom_common.TSometletunset_service_state_timeout~cookie_scope?secure()=tryletc=Eliommod_sersess.find_service_cookie_only~cookie_scope~secure_o:secure()inlettor=c.Eliom_common.sc_timeoutintor:=Eliom_common.TGlobalwithNot_found|Eliom_common.Eliom_Session_expired->()letunset_volatile_data_state_timeout~cookie_scope?secure()=tryletc=Eliommod_datasess.find_data_cookie_only~cookie_scope~secure_o:secure()inlettor=c.Eliom_common.dc_timeoutintor:=Eliom_common.TGlobalwithNot_found|Eliom_common.Eliom_Session_expired->()letget_service_state_timeout~cookie_scope?secure()=letsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()intryletc=Eliommod_sersess.find_service_cookie_only~cookie_scope~secure_o:(Somesecure)~sp()inlettor=c.Eliom_common.sc_timeoutinmatch!torwith|Eliom_common.TGlobal->Eliommod_timeouts.get_global~kind:`Service~cookie_scope~securesitedata|Eliom_common.TNone->None|Eliom_common.TSomet->SometwithNot_found|Eliom_common.Eliom_Session_expired->Eliommod_timeouts.get_global~kind:`Service~cookie_scope~securesitedataletget_volatile_data_state_timeout~cookie_scope?secure()=letsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()intryletc=Eliommod_datasess.find_data_cookie_only~cookie_scope~secure_o:(Somesecure)~sp()inlettor=c.Eliom_common.dc_timeoutinmatch!torwith|Eliom_common.TGlobal->Eliommod_timeouts.get_global~kind:`Data~cookie_scope~securesitedata|Eliom_common.TNone->None|Eliom_common.TSomet->SometwithNot_found|Eliom_common.Eliom_Session_expired->Eliommod_timeouts.get_global~kind:`Data~cookie_scope~securesitedataletset_persistent_data_state_timeout~cookie_scope?securet=let%lwtc=Eliommod_persess.find_or_create_persistent_cookie~cookie_scope~secure_o:secure()inlettor=c.Eliom_common.pc_timeoutinreturn(matchtwith|None->tor:=Eliom_common.TNone|Somet->tor:=Eliom_common.TSomet)letunset_persistent_data_state_timeout~cookie_scope?secure()=try%lwtlet%lwtc=Eliommod_persess.find_persistent_cookie_only~cookie_scope~secure_o:secure()inlettor=c.Eliom_common.pc_timeoutintor:=Eliom_common.TGlobal;return_unitwithNot_found|Eliom_common.Eliom_Session_expired->return_unitletget_persistent_data_state_timeout~cookie_scope?secure()=letsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()intry%lwtlet%lwtc=Eliommod_persess.find_persistent_cookie_only~cookie_scope~secure_o:(Somesecure)~sp()inlettor=c.Eliom_common.pc_timeoutinreturn(match!torwith|Eliom_common.TGlobal->Eliommod_timeouts.get_global~kind:`Persistent~cookie_scope~securesitedata|Eliom_common.TNone->None|Eliom_common.TSomet->Somet)withNot_found|Eliom_common.Eliom_Session_expired->return(Eliommod_timeouts.get_global~kind:`Persistent~cookie_scope~securesitedata)(* Preventing memory leaks: we must close empty sessions *)letrecclose_service_state_if_empty~scope?secure()=(* Close the session if it has not services inside
and no group and no sub sessions *)(* See also in Eliommod_gc and in Eliommod_sessiongroups. *)tryletsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinletc=Eliommod_sersess.find_service_cookie_only~cookie_scope~secure_o:secure~sp()inmatchscopewith|`Session_->(*VVV ??? (match !(c.Eliom_common.sc_session_group) with
| (_, _, Right _) (* no group *)
when *)ifEliommod_sessiongroups.Data.group_size(Eliom_common.get_site_dir_stringsitedata,`Client_process,LeftEliom_common.(Hashed_cookies.to_stringc.sc_hvalue))=0(* no tab sessions *)&&Eliom_common.service_tables_are_empty!(c.Eliom_common.sc_table)thenEliommod_sessiongroups.Data.removec.Eliom_common.sc_session_group_node|`Client_process_->ifEliom_common.service_tables_are_empty!(c.Eliom_common.sc_table)thenEliommod_sessiongroups.Data.removec.Eliom_common.sc_session_group_node|`Session_groupscope_hierarchy->(* There is a browser session, we do not close the group,
but we may close the browser session (this will close
the group if it is empty). *)close_service_state_if_empty~scope:(`Sessionscope_hierarchy)?secure()withNot_found->()letrecclose_volatile_state_if_empty~scope?secure()=(* Close the session if it has not data inside
and no group and no sub sessions *)(* See also in Eliommod_gc and in Eliommod_sessiongroups. *)tryletsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinletc=Eliommod_datasess.find_data_cookie_only~cookie_scope~secure_o:secure~sp()inmatchscopewith|`Session_->(match!(c.Eliom_common.dc_session_group)with|_,_,Right_(* no group *)whenEliommod_sessiongroups.Data.group_size(Eliom_common.get_site_dir_stringsitedata,`Client_process,LeftEliom_common.(Hashed_cookies.to_stringc.dc_hvalue))=0(* no tab sessions *)&&sitedata.Eliom_common.not_bound_in_data_tablesEliom_common.(Hashed_cookies.to_stringc.dc_hvalue)->Eliommod_sessiongroups.Data.removec.Eliom_common.dc_session_group_node|_->())|`Client_process_->()(* This should never occur, because we always have tab session data
when we have a tab session (at least the change_page_event).
if (sitedata.Eliom_common.not_bound_in_data_tables
c.Eliom_common.dc_hvalue)
then Eliommod_sessiongroups.Data.remove
c.Eliom_common.dc_session_group_node *)|`Session_groupscope_hierarchy->(* There is a browser session, we do not close the group,
but we may close the browser session (this will close
the group if it is empty). *)close_volatile_state_if_empty~scope:(`Sessionscope_hierarchy)?secure()withNot_found->()letclose_persistent_state_if_empty~scope:_?secure:_()=Lwt.return_unit(*VVV Can we implement this function? *)(* session groups *)type'astate_data=No_data|Data_session_expired|Dataof'aletset_service_session_group?set_max?(scope=Eliom_common.default_session_scope)?securesession_group=letc=Eliommod_sersess.find_or_create_service_cookie~set_session_group:session_group~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inmatchset_maxwith|None->()|Somem->Eliommod_sessiongroups.Data.set_maxc.Eliom_common.sc_session_group_nodemletunset_service_session_group?set_max?(scope=Eliom_common.default_session_scope)?secure()=tryletsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletc=Eliommod_sersess.find_service_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure~sp()inletn=Eliommod_sessiongroups.make_full_group_name~cookie_level:`Session(Eliom_request_info.get_request_spsp).Ocsigen_extensions.request_info(Eliom_common.get_site_dir_stringsitedata)(Eliom_common.get_mask4sitedata)(Eliom_common.get_mask6sitedata)Noneinletnode=Eliommod_sessiongroups.Serv.move?set_maxsitedatac.Eliom_common.sc_session_group_nodeninc.Eliom_common.sc_session_group_node<-node;c.Eliom_common.sc_session_group:=n;(* Now we want to close the session if it has not data inside
and no tab sessions *)close_service_state_if_empty~scope:(scope:>Eliom_common.user_scope)?secure()withNot_found|Eliom_common.Eliom_Session_expired->()letget_service_session_group?(scope=Eliom_common.default_session_scope)?secure()=tryletc=Eliommod_sersess.find_service_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inmatch!(c.Eliom_common.sc_session_group)with|_,_,Right_->None|_,_,Leftv->SomevwithNot_found|Eliom_common.Eliom_Session_expired->Noneletget_service_session_group_size?(scope=Eliom_common.default_session_scope)?secure()=tryletc=Eliommod_sersess.find_service_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inmatch!(c.Eliom_common.sc_session_group)with|_,_,Right_->None|_,_,Left_->Some(Eliommod_sessiongroups.Serv.group_size!(c.Eliom_common.sc_session_group))withNot_found|Eliom_common.Eliom_Session_expired->Noneletset_volatile_data_session_group?set_max?(scope=Eliom_common.default_session_scope)?securesession_group=letc=Eliommod_datasess.find_or_create_data_cookie~set_session_group:session_group~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inmatchset_maxwith|None->()|Somem->Eliommod_sessiongroups.Data.set_maxc.Eliom_common.dc_session_group_nodemletunset_volatile_data_session_group?set_max?(scope=Eliom_common.default_session_scope)?secure()=tryletsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinletc=Eliommod_datasess.find_data_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure~sp()inletn=Eliommod_sessiongroups.make_full_group_name~cookie_level:`Session(Eliom_request_info.get_request_spsp).Ocsigen_extensions.request_info(Eliom_common.get_site_dir_stringsitedata)(Eliom_common.get_mask4sitedata)(Eliom_common.get_mask6sitedata)Noneinletnode=Eliommod_sessiongroups.Data.move?set_maxsitedatac.Eliom_common.dc_session_group_nodeninc.Eliom_common.dc_session_group_node<-node;c.Eliom_common.dc_session_group:=n;(* Now we want to close the session if it has not data inside
and no tab sessions *)close_volatile_state_if_empty~scope:(scope:>Eliom_common.user_scope)?secure()withNot_found|Eliom_common.Eliom_Session_expired->()letget_volatile_data_session_group?(scope=Eliom_common.default_session_scope)?secure()=tryletc=Eliommod_datasess.find_data_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inmatch!(c.Eliom_common.dc_session_group)with|_,_,Right_->None|_,_,Leftv->SomevwithNot_found|Eliom_common.Eliom_Session_expired->Noneletget_volatile_data_session_group_size?(scope=Eliom_common.default_session_scope)?secure()=tryletc=Eliommod_datasess.find_data_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inmatch!(c.Eliom_common.dc_session_group)with|_,_,Right_->None|_,_,Left_->Some(Eliommod_sessiongroups.Data.group_size!(c.Eliom_common.dc_session_group))withNot_found|Eliom_common.Eliom_Session_expired->Noneletset_persistent_data_session_group?set_max?(scope=Eliom_common.default_session_scope)?securen=letsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spinlet%lwtc=Eliommod_persess.find_or_create_persistent_cookie~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure~sp()inletn=Eliommod_sessiongroups.make_persistent_full_group_name~cookie_level:`Session(Eliom_common.get_site_dir_stringsitedata)(Somen)inletgrp=c.Eliom_common.pc_session_groupinlet%lwtl=Eliommod_sessiongroups.Pers.movesitedata?set_max(fstsitedata.Eliom_common.max_persistent_data_sessions_per_group)Eliom_common.(Hashed_cookies.to_stringc.pc_hvalue)!grpninlet%lwt()=Lwt_list.iter_p(Eliommod_persess.close_persistent_state2~scope:(scope:>Eliom_common.user_scope)sitedataNone)lingrp:=n;Lwt.return_unitletunset_persistent_data_session_group?(scope=Eliom_common.default_session_scope)?secure()=letsp=Eliom_common.get_sp()inletsitedata=Eliom_request_info.get_sitedata_sp~spintry%lwtlet%lwtc=Eliommod_persess.find_persistent_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure~sp()inletgrp=c.Eliom_common.pc_session_groupinlet%lwt()=Eliommod_sessiongroups.Pers.removesitedataEliom_common.(Hashed_cookies.to_stringc.pc_hvalue)!grpingrp:=None;close_persistent_state_if_empty~scope:(scope:>Eliom_common.user_scope)?secure()withNot_found|Eliom_common.Eliom_Session_expired->Lwt.return_unitletget_persistent_data_session_group?(scope=Eliom_common.default_session_scope)?secure()=try%lwtlet%lwtc=Eliommod_persess.find_persistent_cookie_only~cookie_scope:(scope:>Eliom_common.cookie_scope)~secure_o:secure()inLwt.return(match!(c.Eliom_common.pc_session_group)with|None->None|Somev->(matchEliommod_sessiongroups.getperssessgrpvwith|_,_,Lefts->Somes|_->None))withNot_found|Eliom_common.Eliom_Session_expired->Lwt.return_none(* max *)letset_default_max_service_sessions_per_group?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_service_sessions_per_group"inletb=sndsitedata.Eliom_common.max_service_sessions_per_groupinifoverride_configfile||notbthensitedata.Eliom_common.max_service_sessions_per_group<-n,bletset_default_max_volatile_data_sessions_per_group?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_volatile_data_sessions_per_group"inletb=sndsitedata.Eliom_common.max_volatile_data_sessions_per_groupinifoverride_configfile||notbthensitedata.Eliom_common.max_volatile_data_sessions_per_group<-n,bletset_default_max_persistent_data_sessions_per_group?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_persistent_data_sessions_per_group"inletb=sndsitedata.Eliom_common.max_persistent_data_sessions_per_groupinifoverride_configfile||notbthensitedata.Eliom_common.max_persistent_data_sessions_per_group<-n,bletset_default_max_service_sessions_per_subnet?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_service_sessions_per_subnet"inletb=sndsitedata.Eliom_common.max_service_sessions_per_subnetinifoverride_configfile||notbthensitedata.Eliom_common.max_service_sessions_per_subnet<-n,bletset_default_max_volatile_data_sessions_per_subnet?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_volatile_data_sessions_per_subnet"inletb=sndsitedata.Eliom_common.max_volatile_data_sessions_per_subnetinifoverride_configfile||notbthensitedata.Eliom_common.max_volatile_data_sessions_per_subnet<-n,bletset_default_max_volatile_sessions_per_group?override_configfilen=set_default_max_service_sessions_per_group?override_configfilen;set_default_max_volatile_data_sessions_per_group?override_configfilenletset_default_max_volatile_sessions_per_subnet?override_configfilen=set_default_max_service_sessions_per_subnet?override_configfilen;set_default_max_volatile_data_sessions_per_subnet?override_configfilenletset_default_max_service_tab_sessions_per_group?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_service_tab_sessions_per_group"inletb=sndsitedata.Eliom_common.max_service_tab_sessions_per_groupinifoverride_configfile||notbthensitedata.Eliom_common.max_service_tab_sessions_per_group<-n,bletset_default_max_volatile_data_tab_sessions_per_group?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_volatile_data_tab_sessions_per_group"inletb=sndsitedata.Eliom_common.max_volatile_data_tab_sessions_per_groupinifoverride_configfile||notbthensitedata.Eliom_common.max_volatile_data_tab_sessions_per_group<-n,bletset_default_max_persistent_data_tab_sessions_per_group?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_default_max_persistent_data_tab_sessions_per_group"inletb=sndsitedata.Eliom_common.max_persistent_data_tab_sessions_per_groupinifoverride_configfile||notbthensitedata.Eliom_common.max_persistent_data_tab_sessions_per_group<-n,bletset_default_max_volatile_tab_sessions_per_group?override_configfilen=set_default_max_service_tab_sessions_per_group?override_configfilen;set_default_max_volatile_data_tab_sessions_per_group?override_configfilenletset_ipv4_subnet_mask?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_ipv4_subnet_mask"inletb=sndsitedata.Eliom_common.ipv4maskinifoverride_configfile||notbthensitedata.Eliom_common.ipv4mask<-Somen,bletset_ipv6_subnet_mask?(override_configfile=false)n=letsitedata=Eliom_request_info.find_sitedata"set_ipv6_subnet_mask"inletb=sndsitedata.Eliom_common.ipv6maskinifoverride_configfile||notbthensitedata.Eliom_common.ipv6mask<-Somen,bletset_max_service_states_for_group_or_subnet~scope?securem=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinletc=Eliommod_sersess.find_or_create_service_cookie~secure_o:secure~cookie_scope()inmatchscopewith|`Session_group_->(matchEliommod_sessiongroups.Data.find_node_in_group_of_groups!(c.Eliom_common.sc_session_group)with|Somenode->Eliommod_sessiongroups.Data.set_maxnodem|_->())|_->Eliommod_sessiongroups.Data.set_maxc.Eliom_common.sc_session_group_nodemletset_max_volatile_data_states_for_group_or_subnet~scope?securem=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinletc=Eliommod_datasess.find_or_create_data_cookie~cookie_scope~secure_o:secure()inmatchscopewith|`Session_group_->(matchEliommod_sessiongroups.Serv.find_node_in_group_of_groups!(c.Eliom_common.dc_session_group)with|Some(_,node)->Eliommod_sessiongroups.Data.set_maxnodem|_->())|_->Eliommod_sessiongroups.Data.set_maxc.Eliom_common.dc_session_group_nodemletset_max_volatile_states_for_group_or_subnet~scope?securem=set_max_service_states_for_group_or_subnet~scope?securem;set_max_volatile_data_states_for_group_or_subnet~scope?securem(*VVV No version for persistent sessions? Why? *)(* expiration dates *)letset_service_cookie_exp_date~cookie_scope?securet=letc=Eliommod_sersess.find_or_create_service_cookie~cookie_scope~secure_o:secure()inletexp=c.Eliom_common.sc_cookie_expinmatchtwith|None->exp:=Eliom_common.CEBrowser|Somet->exp:=Eliom_common.CESomet(*
let get_service_cookie_exp_date ?state_name ?(cookie_level = `Session) ?secure () =
try
let (_, _, _, _, exp) = find_service_cookie_only ?state_name ~cookie_level ~secure () in
let exp = c.Eliom_common.sc_cookie_exp in
!exp
with Not_found | Eliom_common.Eliom_Session_expired -> Eliom_common.CEBrowser
*)letset_volatile_data_cookie_exp_date~cookie_scope?securet=letc=Eliommod_datasess.find_or_create_data_cookie~cookie_scope~secure_o:secure()inletexp=c.Eliom_common.dc_cookie_expinmatchtwith|None->exp:=Eliom_common.CEBrowser|Somet->exp:=Eliom_common.CESometletset_persistent_data_cookie_exp_date~cookie_scope?securet=let%lwtc=Eliommod_persess.find_or_create_persistent_cookie~cookie_scope~secure_o:secure()inletexp=c.Eliom_common.pc_cookie_expinreturn(matchtwith|None->exp:=Eliom_common.CEBrowser|Somet->exp:=Eliom_common.CESomet)(* *)letget_global_table()=letsitedata=Eliom_request_info.find_sitedata"get_global_table"insitedata.Eliom_common.global_services(** If the session does not exist, we create it
(new cookie, new session service table) *)letget_session_service_table~sp~scope?secure()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinletc=Eliommod_sersess.find_or_create_service_cookie~cookie_scope~secure_o:secure~sp()inmatchscopewith|`Session_group_->(matchEliommod_sessiongroups.Serv.find_node_in_group_of_groups!(c.Eliom_common.sc_session_group)with|None->raiseNot_found|Some(t,_)->t)|_->c.Eliom_common.sc_table(** If the session does not exist, we raise Not_found *)letget_session_service_table_if_exists~sp~scope?secure()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeintryletc=Eliommod_sersess.find_service_cookie_only~cookie_scope~secure_o:secure~sp()inmatchscopewith|`Session_group_->(matchEliommod_sessiongroups.Serv.find_node_in_group_of_groups!(c.Eliom_common.sc_session_group)with|None->raiseNot_found|Some(t,_)->t)|_->c.Eliom_common.sc_tablewithEliom_common.Eliom_Session_expired->raiseNot_found(*****************************************************************************)(** {2 persistent sessions} *)moduleOcsipersist=Eliom_common.Ocsipersist.Polymorphictype'apersistent_table=Eliom_common.user_scope*bool*(int64*'a)Ocsipersist.tableletcreate_persistent_table~scope?securename:'apersistent_tableLwt.t=letsitedata=Eliom_request_info.find_sitedata"create_persistent_table"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliom_common.Persistent_tables.createname>>=funt->Lwt.return(scope,secure,t)letget_p_table_key_~table:(scope,secure,table)(find_cookie:cookie_scope:Eliom_common.cookie_scope->secure_o:booloption->?sp:Eliom_common.server_params->unit->Eliom_common.one_persistent_cookie_infoLwt.t)=letget_cookie()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinlet%lwtc=find_cookie~cookie_scope~secure_o:(Somesecure)()inLwt.returnEliom_common.(Hashed_cookies.to_stringc.pc_hvalue)inlet%lwtkey=matchscopewith|`Session_groupstate_name->(match%lwtget_persistent_data_session_group~scope:(`Sessionstate_name)~secure()with|Somea->Lwt.returna|None->(* No session group. We use the session cookie as key. *)get_cookie())|_->get_cookie()inLwt.return(table,key)letget_persistent_data~table()=catch(fun()->get_p_table_key_~tableEliommod_persess.find_persistent_cookie_only>>=fun(table,key)->Ocsipersist.findtablekey>>=fun(_,v)->Lwt.return(Datav))(function|Eliom_common.Eliom_Session_expired->returnData_session_expired|Not_found->returnNo_data|e->faile)letset_persistent_data~tablevalue=letf__~cookie_scope~secure_o?sp()=Eliommod_persess.find_or_create_persistent_cookie~cookie_scope~secure_o?sp()inget_p_table_key_~tablef__>>=fun(table,key)->Ocsipersist.addtablekey(Int64.zero,value)letremove_persistent_data~table()=try%lwtletscope,secure,_=tableinlet%lwttable,key=get_p_table_key_~tableEliommod_persess.find_persistent_cookie_onlyinlet%lwt()=Ocsipersist.removetablekeyinclose_persistent_state_if_empty~scope~secure()withNot_found|Eliom_common.Eliom_Session_expired->return_unit(*****************************************************************************)(** {2 session data in memory} *)type'avolatile_table=Eliom_common.user_scope*bool*'aEliom_common.SessionCookies.tletcreate_volatile_table_during_session_=Eliommod_datasess.create_volatile_table_during_sessionletcreate_volatile_table~scope?secure()=matchEliom_common.get_sp_option()with|None->(matchEliom_common.global_register_allowed()with|Someget_current_sitedata->letsitedata=get_current_sitedata()inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_datasess.create_volatile_table~scope~secure|None->raise(Eliom_common.Eliom_site_information_not_available"create_volatile_table"))|Somesp->letsitedata=Eliom_request_info.get_sitedata_sp~spinletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()increate_volatile_table_during_session_~scope~securesitedataletget_table_key_~table:(scope,secure,table)(find_cookie:cookie_scope:Eliom_common.cookie_scope->secure_o:booloption->?sp:Eliom_common.server_params->unit->Eliom_common.one_data_cookie_info)=(* The key in the table is the cookie for client processes and sessions,
and the group name for groups *)letget_cookie()=letcookie_scope=Eliom_common.cookie_scope_of_user_scopescopeinletc=find_cookie~cookie_scope~secure_o:(Somesecure)()inEliom_common.(Hashed_cookies.to_stringc.dc_hvalue)in(table,matchscopewith|`Session_groupstate_name->(matchget_volatile_data_session_group~scope:(`Sessionstate_name)~secure()with|Somea->a|None->(* No session group has been set. We use the session instead. *)get_cookie())|_->get_cookie())letget_volatile_data~table()=trylettable,key=get_table_key_~tableEliommod_datasess.find_data_cookie_onlyinData(Eliom_common.SessionCookies.findtablekey)with|Not_found->No_data|Eliom_common.Eliom_Session_expired->Data_session_expiredletset_volatile_data~tablevalue=letf__~cookie_scope~secure_o?sp()=Eliommod_datasess.find_or_create_data_cookie~cookie_scope~secure_o?sp()inlettable,key=get_table_key_~tablef__inEliom_common.SessionCookies.replacetablekeyvalueletremove_volatile_data~table()=tryletscope,secure,_=tableinlettable,key=get_table_key_~tableEliommod_datasess.find_data_cookie_onlyinEliom_common.SessionCookies.removetablekey;(* Now we want to close the session if it has not data inside
and no group and no sub sessions *)close_volatile_state_if_empty~scope~secure()withNot_found|Eliom_common.Eliom_Session_expired->()(*****************************************************************************)(** Close a state *)letdiscard_persistent_data~scope?secure()=matchsecurewith|None->Eliommod_persess.close_persistent_state~scope~secure_o:(Sometrue)()>>=fun()->Eliommod_persess.close_persistent_state~scope~secure_o:(Somefalse)()|_->Eliommod_persess.close_persistent_state~scope~secure_o:secure()letdiscard_services~scope?secure()=matchsecurewith|None->Eliommod_sersess.close_service_state~scope~secure_o:(Sometrue)();Eliommod_sersess.close_service_state~scope~secure_o:(Somefalse)()|_->Eliommod_sersess.close_service_state~scope~secure_o:secure()letdiscard_volatile_data~scope?secure()=matchsecurewith|None->Eliommod_datasess.close_data_state~scope~secure_o:(Sometrue)();Eliommod_datasess.close_data_state~scope~secure_o:(Somefalse)()|_->Eliommod_datasess.close_data_state~scope~secure_o:secure()letdiscard_request_data()=lettable=Eliom_request_info.get_request_cache()inPolytables.clear~table;Lwt.return_unitletdiscard_data?persistent~scope?secure()=matchscopewith|#Eliom_common.request_scope->discard_request_data()|#Eliom_common.user_scopeasscope->((matchpersistentwith|None|Somefalse->discard_volatile_data~scope?secure()|_->());matchpersistentwith|None|Sometrue->discard_persistent_data~scope?secure()|_->Lwt.return_unit)letdiscard~scope?secure()=matchscopewith|#Eliom_common.request_scope->discard_request_data()|#Eliom_common.user_scopeasscope->discard_services~scope:(scope:>[<Eliom_common.user_scope])?secure();discard_data~scope:(scope:>[<Eliom_common.user_scope])?secure()(* will close volatile and persistent sessions for one scope *)letdiscard_all_scopes?secure()=letdiscard_namescope_hierarchy=let%lwt()=discard?secure~scope:(`Session_groupscope_hierarchy)()inlet%lwt()=discard?secure~scope:(`Sessionscope_hierarchy)()indiscard?secure~scope:(`Client_processscope_hierarchy)()inlet%lwt()=discard_request_data()inLwt_list.iter_pdiscard_name(Eliom_common.list_scope_hierarchies())letdiscard_all_volatile_data~scope?secure()=letsitedata=Eliom_request_info.find_sitedata"discard_all_volatile_data"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_sessadmin.close_all_data_states~scope~securesitedata(*VVV missing: scope group *)letdiscard_all_persistent_data~scope?secure()=letsitedata=Eliom_request_info.find_sitedata"discard_all_persistent_data"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_sessadmin.close_all_persistent_states~scope~securesitedata(*VVV missing: scope group *)letdiscard_all_data?persistent~scope?secure()=let%lwt()=matchpersistentwith|None|Somefalse->discard_all_volatile_data~scope?secure()|_->Lwt.return_unitinmatchpersistentwith|None|Sometrue->discard_all_persistent_data~scope?secure()|_->Lwt.return_unitletdiscard_all_services~scope?secure()=letsitedata=Eliom_request_info.find_sitedata"close_all_service_sessions"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inEliommod_sessadmin.close_all_service_states~scope~securesitedata(*VVV missing: scope group *)letdiscard_all~scope?secure()=let%lwt()=discard_all_services~scope?secure()indiscard_all_data~scope?secure()letdiscard_everything()=letdiscard_namescope_hierarchy=let%lwt()=discard_all~scope:(`Session_groupscope_hierarchy)()inlet%lwt()=discard_all~scope:(`Sessionscope_hierarchy)()indiscard_all~scope:(`Client_processscope_hierarchy)()inlet%lwt()=discard_request_data()inLwt_list.iter_pdiscard_name(Eliom_common.list_scope_hierarchies())(*****************************************************************************)(* Administration *)moduleExt=struct(** Type used to describe session timeouts *)typetimeout=Eliom_common.timeout=|TGlobal(** see global setting *)|TNone(** explicitly set no timeout *)|TSomeoffloat(** timeout duration in seconds *)type(+'a(* scope *),+'b(* `Data, `Service or `Pers *))state=Eliom_common.user_scope*[`Data|`Service|`Pers]*stringtypeservice_cookie_info=string(* cookie value *)*Eliom_common.tablesEliom_common.Service_cookie.ttypedata_cookie_info=string(* cookie value *)*Eliom_common.Data_cookie.ttypepersistent_cookie_info=string(* cookie value *)*Eliommod_cookies.cookieletuntype_statestate=state(*VVV Do we need this? + check
(* The following function returns the group to which belongs
a session or client process state: *)
let group_of ~state:(_cookie, (_, _, _, _, sgr, _sgrnode)) =
match Eliommod_sessiongroups.Serv.find_node_in_group_of_groups !sgr with
| Some a -> a
| None -> (* the group of a tab session,
that is, the browser session associated. *)
Eliommod_sessiongroups.make_full_named_group_name_
~cookie_level:`Client_process sitedata cookie
(*VVV à vérifier *)
*)letvolatile_data_group_state?(scope=Eliom_common.default_group_scope)group_name=(scope:>Eliom_common.user_scope),`Data,group_nameletpersistent_data_group_state?(scope=Eliom_common.default_group_scope)group_name=(scope:>Eliom_common.user_scope),`Pers,group_nameletservice_group_state?(scope=Eliom_common.default_group_scope)group_name=(scope:>Eliom_common.user_scope),`Service,group_nameletcurrent_volatile_data_state?secure?(scope=(Eliom_common.default_session_scope:>Eliom_common.user_scope))()=letscope=(scope:>Eliom_common.user_scope)inmatchscopewith|`Session_grouph->(matchget_volatile_data_session_group~scope:(`Sessionh)?secure()with|Someg->volatile_data_group_state~scope:(`Session_grouph)g|None->raiseNot_found)|#Eliom_common.cookie_scopeascookie_scope->letcookie=Eliommod_datasess.find_or_create_data_cookie~secure_o:secure~cookie_scope()in((scope,`Data,Eliom_common.(Hashed_cookies.to_stringcookie.dc_hvalue)):('a,'b)state)letcurrent_persistent_data_state?secure?(scope=(Eliom_common.default_session_scope:>Eliom_common.user_scope))()=letscope=(scope:>Eliom_common.user_scope)inmatchscopewith|`Session_grouph->(match%lwtget_persistent_data_session_group~scope:(`Sessionh)?secure()with|Someg->persistent_data_group_state~scope:(`Session_grouph)g|>Lwt.return|None->Lwt.failNot_found)|#Eliom_common.cookie_scopeascookie_scope->Eliommod_persess.find_or_create_persistent_cookie~secure_o:secure~cookie_scope()>>=funcookie->Lwt.return(scope,`Pers,Eliom_common.(Hashed_cookies.to_stringcookie.pc_hvalue))letcurrent_service_state?secure?(scope=(Eliom_common.default_session_scope:>Eliom_common.user_scope))()=letscope=(scope:>Eliom_common.user_scope)inmatchscopewith|`Session_grouph->(matchget_service_session_group~scope:(`Sessionh)?secure()with|Someg->service_group_state~scope:(`Session_grouph)g|None->raiseNot_found)|#Eliom_common.cookie_scopeascookie_scope->letcookie=Eliommod_sersess.find_or_create_service_cookie~secure_o:secure~cookie_scope()in(scope,`Service,Eliom_common.(Hashed_cookies.to_stringcookie.sc_hvalue))letget_service_cookie_info?(sitedata=Eliom_request_info.find_sitedata"Eliom_state.get_service_cookie_info")((_,_,cookie):([<Eliom_common.cookie_level],[`Service])state)=(cookie,Eliom_common.SessionCookies.findsitedata.Eliom_common.session_servicescookie)letget_volatile_data_cookie_info?(sitedata=Eliom_request_info.find_sitedata"Eliom_state.get_volatile_data_cookie_info")((_,_,cookie):([<Eliom_common.cookie_level],[`Data])state)=(cookie,Eliom_common.SessionCookies.findsitedata.Eliom_common.session_datacookie)letget_persistent_cookie_info((_,_,cookie):([<Eliom_common.cookie_level],[`Pers])state)=Eliommod_cookies.Persistent_cookies.Cookies.findcookie>>=funv->Lwt.return(cookie,v)letdiscard_state?(sitedata=Eliom_request_info.find_sitedata"Eliom_state.discard_state")~state()=letmake_sessgrpn=Eliom_common.get_site_dir_stringsitedata,`Session,Leftninmatchstatewith|`Session_group_,`Data,group_name->(matchEliommod_sessiongroups.Data.find_node_in_group_of_groups(make_sessgrpgroup_name)with|Somenode->Eliommod_sessiongroups.Data.removenode|None->());Lwt.return_unit|`Session_group_,`Service,group_name->(matchEliommod_sessiongroups.Serv.find_node_in_group_of_groups(make_sessgrpgroup_name)with|Some(_,node)->Eliommod_sessiongroups.Serv.removenode|None->());Lwt.return_unit|`Session_group_,`Pers,group_name->letsgr_o=Eliom_common.make_persistent_full_group_name~cookie_level:`Session(Eliom_common.get_site_dir_stringsitedata)(Somegroup_name)inEliommod_sessiongroups.Pers.remove_group~cookie_level:`Sessionsitedatasgr_o|_,`Service,(_cookie:string)->let()=matchget_service_cookie_info~sitedatastatewith|exceptionNot_found->()|_,{Eliom_common.Service_cookie.session_group_node;_}->Eliommod_sessiongroups.Serv.removesession_group_nodeinLwt.return_unit|_,`Data,_cookie->let()=matchget_volatile_data_cookie_info~sitedatastatewith|exceptionNot_found->()|_,{Eliom_common.Data_cookie.session_group_node;_}->Eliommod_sessiongroups.Data.removesession_group_nodeinLwt.return_unit|_,`Pers,_cookie->(match%lwtget_persistent_cookie_infostatewith|exceptionNot_found->Lwt.return_unit|cookie,{Eliommod_cookies.full_state_name;session_group;_}->letscope=full_state_name.Eliom_common.user_scopeinletcookie_level=Eliom_common.cookie_level_of_user_scopescopeinEliommod_sessiongroups.Pers.close_persistent_session2~cookie_levelsitedatasession_groupcookie)(*VVV!!! est-ce que session_group est fullsessgrp ? *)letfold_sub_states_aux_aux?(sitedata=Eliom_request_info.find_sitedata"Eliom_state (state iterator)")~state:((s,k,id):([<`Session_group|`Session],[<`Pers|`Data|`Service])state)f=(* id is the session cookie value or the group name *)letreduce_scope=function|`Session_groupn->`Sessionn|`Sessionn->`Client_processn|`Client_process_->failwith"fold_sub_states"inletreduce_level=function|`Session_group_->`Session|`Session_->`Client_process|`Client_process_->failwith"fold_sub_states"inletsub_states_level=reduce_levelsinletsub_states_scope=reduce_scopesinletfav=fa(sub_states_scope,k,v)insitedata,sub_states_level,id,fletfold_sub_states_auxfoldreturn(sitedata,sub_states_level,id,f)e=function|_,`Data,_->(tryletdl=Eliommod_sessiongroups.Data.find(Eliom_common.get_site_dir_stringsitedata,sub_states_level,Leftid)infoldfedlwithNot_found->returne)|_,`Service,_->(tryletdl=Eliommod_sessiongroups.Serv.find(Eliom_common.get_site_dir_stringsitedata,sub_states_level,Leftid)infoldfedlwithNot_found->returne)|_->failwith"fold_sub_states_aux"letfold_volatile_sub_states?sitedata~(state:Eliom_common.user_scope*[>`Data|`Service]*string)fe=letstate'=(state:>('aa,'bb)state)inleta=fold_sub_states_aux_aux?sitedata~state:state'finfold_sub_states_auxOcsigen_cache.Dlist.foldOcsigen_lib.idaestateletfold_sub_states?sitedata~statefe=let((sitedata,sub_states_level,id,f)asa)=fold_sub_states_aux_aux?sitedata~statefinmatchstatewith|_,`Pers,_->Eliommod_sessiongroups.Pers.find(Eliom_common.make_persistent_full_group_name~cookie_level:sub_states_level(Eliom_common.get_site_dir_stringsitedata)(Someid))>>=funl->Lwt_list.fold_left_sfel|_->fold_sub_states_auxOcsigen_cache.Dlist.lwt_foldLwt.returnaestateletiter_volatile_sub_states?sitedata~statef=fold_volatile_sub_states?sitedata~state(fun()->f)()letiter_sub_states?sitedata~statef=fold_sub_states?sitedata~state(fun()->f)()exceptionWrong_scopemoduleLow_level=struct(* We have a dynamic scope checking here.
Would probably be possible to use phantom types again to check this
statically. I don't want to make the types more complex for now.
-- Vincent
*)letcheck_scopestable_scopestate_scope=iftable_scope<>state_scopethenraiseWrong_scopeletlwt_check_scopesab=trycheck_scopesab;Lwt.return_unitwithe->Lwt.faile(*VVV Does not work with volatile group data *)letget_volatile_data~state:((state_scope,_,cookie):('s,[`Data])state)~table:((table_scope,_secure,t):'avolatile_table)=check_scopestable_scopestate_scope;Eliom_common.SessionCookies.findtcookieletget_persistent_data~state:((state_scope,_,cookie):('s,[`Pers])state)~table:((table_scope,_,t):'apersistent_table)=lwt_check_scopestable_scopestate_scope>>=fun()->Ocsipersist.findtcookie>>=fun(_,a)->Lwt.returnaletset_volatile_data~state:((state_scope,_,cookie):('s,[`Data])state)~table:((table_scope,_secure,t):'avolatile_table)value=check_scopestable_scopestate_scope;Eliom_common.SessionCookies.replacetcookievalueletset_persistent_data~state:((state_scope,_,cookie):('s,[`Pers])state)~table:((table_scope,_,t):'apersistent_table)value=lwt_check_scopestable_scopestate_scope>>=fun()->Ocsipersist.addtcookie(Int64.zero,value)letremove_volatile_data~state:((state_scope,_,cookie):('s,[`Data])state)~table:((table_scope,_,t):'avolatile_table)=check_scopestable_scopestate_scope;Eliom_common.SessionCookies.removetcookieletremove_persistent_data~state:((state_scope,_,cookie):('s,[`Pers])state)~table:((table_scope,_,t):'apersistent_table)=lwt_check_scopestable_scopestate_scope>>=fun()->Ocsipersist.removetcookieendletget_service_cookie_scope~cookie:(_,cookie)=cookie.Eliom_common.Service_cookie.full_state_name.Eliom_common.user_scopeletget_volatile_data_cookie_scope~cookie:(_,data_cookie)=data_cookie.Eliom_common.Data_cookie.full_state_name.Eliom_common.user_scopeletget_persistent_data_cookie_scope~cookie:(_,cookie)=cookie.Eliommod_cookies.full_state_name.Eliom_common.user_scopeletset_service_cookie_timeout~cookie:(_,cookie)t=cookie.Eliom_common.Service_cookie.timeout:=matchtwithNone->TNone|Somet->TSometletset_volatile_data_cookie_timeout~cookie:(_,data_cookie)t=data_cookie.Eliom_common.Data_cookie.timeout:=matchtwithNone->TNone|Somet->TSometletset_persistent_data_cookie_timeout~cookie:(c,cookie)t=letti=matchtwithNone->TNone|Somet->TSometinEliommod_cookies.Persistent_cookies.addc{cookiewithEliommod_cookies.timeout=ti}letget_service_cookie_timeout~cookie:(_,cookie)=!(cookie.Eliom_common.Service_cookie.timeout)letget_volatile_data_cookie_timeout~cookie:(_,data_cookie)=!(data_cookie.Eliom_common.Data_cookie.timeout)letget_persistent_data_cookie_timeout~cookie:(_,cookie)=cookie.Eliommod_cookies.timeoutletunset_service_cookie_timeout~cookie:(_,cookie)=cookie.Eliom_common.Service_cookie.timeout:=TGloballetunset_volatile_data_cookie_timeout~cookie:(_cookie,data_cookie)=data_cookie.Eliom_common.Data_cookie.timeout:=TGloballetunset_persistent_data_cookie_timeout~cookie:(c,cookie)=Eliommod_cookies.Persistent_cookies.Cookies.addc{cookiewithEliommod_cookies.timeout=TGlobal}>>=fun()->let{Eliommod_cookies.expiry;_}=cookieinEliommod_cookies.Persistent_cookies.Expiry_dates.remove_cookieexpirycletget_session_group_list()=letsitedata=Eliom_request_info.find_sitedata"get_session_group_list"inletdl=sitedata.Eliom_common.group_of_groupsinOcsigen_cache.Dlist.fold(funl->function_,`Session,Lefts->s::l|_->l)[]dl(** Iterator on service cookies *)letiter_service_cookies=Eliommod_sessexpl.iter_service_cookies(** Iterator on data cookies *)letiter_volatile_data_cookies=Eliommod_sessexpl.iter_data_cookies(** Iterator on persistent cookies *)letiter_persistent_data_cookies=Eliommod_sessexpl.iter_persistent_cookies(** Iterator on service cookies *)letfold_service_cookies=Eliommod_sessexpl.fold_service_cookies(** Iterator on data cookies *)letfold_volatile_data_cookies=Eliommod_sessexpl.fold_data_cookies(** Iterator on persistent cookies *)letfold_persistent_data_cookies=Eliommod_sessexpl.fold_persistent_cookiesend(*****************************************************************************)(* Exploration *)letnumber_of_service_cookies=Eliommod_sessexpl.number_of_service_cookiesletnumber_of_volatile_data_cookies=Eliommod_sessexpl.number_of_data_cookiesletnumber_of_tables=Eliommod_sessexpl.number_of_tablesletnumber_of_table_elements=Eliommod_sessexpl.number_of_table_elementsletnumber_of_persistent_data_cookies=Eliommod_sessexpl.number_of_persistent_cookiesletnumber_of_persistent_tables=Eliom_common.Persistent_tables.number_of_tablesletnumber_of_persistent_table_elements=Eliom_common.Persistent_tables.number_of_table_elements(*****************************************************************************)letget_service_cookie~cookie_scope?secure()=tryletc=Eliommod_sersess.find_service_cookie_only~cookie_scope~secure_o:secure()inSomec.Eliom_common.sc_hvaluewithNot_found|Eliom_common.Eliom_Session_expired->Noneletget_volatile_data_cookie~cookie_scope?secure()=tryletc=Eliommod_datasess.find_data_cookie_only~cookie_scope~secure_o:secure()inSomec.Eliom_common.dc_hvaluewithNot_found|Eliom_common.Eliom_Session_expired->Noneletget_persistent_data_cookie~cookie_scope?secure()=try%lwtlet%lwtc=Eliommod_persess.find_persistent_cookie_only~cookie_scope~secure_o:secure()inreturn_somec.Eliom_common.pc_hvaluewithNot_found|Eliom_common.Eliom_Session_expired->return_none(*****************************************************************************)(** {2 User cookies} *)letchange_pathopt_sp=function|None->Eliom_common.get_site_dir(Eliom_request_info.get_sitedata_sp~sp)(* Not possible to set a cookie for another site (?) *)|Somep->Eliom_common.get_site_dir(Eliom_request_info.get_sitedata_sp~sp)@pletset_cookie?(cookie_level=`Session)?path?exp?secure~name~value()=letsp=Eliom_common.get_sp()inletpath=change_pathopt_sppathinletsitedata=Eliom_request_info.find_sitedata"set_cookie"inletsecure=Eliom_common.get_secure~secure_o:secure~sitedata()inmatchcookie_levelwith|`Session->sp.Eliom_common.sp_user_cookies<-Ocsigen_cookie_map.add~pathname(OSet(exp,value,secure))sp.Eliom_common.sp_user_cookies|`Client_process->sp.Eliom_common.sp_user_tab_cookies<-Ocsigen_cookie_map.add~pathname(OSet(exp,value,secure))sp.Eliom_common.sp_user_tab_cookiesletunset_cookie?(cookie_level=`Session)?path~name()=letsp=Eliom_common.get_sp()inletpath=change_pathopt_sppathinmatchcookie_levelwith|`Session->sp.Eliom_common.sp_user_cookies<-Ocsigen_cookie_map.add~pathnameOUnsetsp.Eliom_common.sp_user_cookies|`Client_process->sp.Eliom_common.sp_user_tab_cookies<-Ocsigen_cookie_map.add~pathnameOUnsetsp.Eliom_common.sp_user_tab_cookies