├── .gitignore ├── .travis.yml ├── Build.PL ├── Changes ├── LICENSE ├── META.json ├── README.md ├── cpanfile ├── dist.ini ├── examples └── counter-raw.psgi ├── lib └── Plack │ ├── Middleware │ ├── Session.pm │ └── Session │ │ └── Cookie.pm │ ├── Session.pm │ └── Session │ ├── Cleanup.pm │ ├── State.pm │ ├── State │ └── Cookie.pm │ ├── Store.pm │ └── Store │ ├── Cache.pm │ ├── DBI.pm │ ├── File.pm │ └── Null.pm └── t ├── 000_load.t ├── 001_basic.t ├── 001a_basic.t ├── 002_basic_w_cookie.t ├── 002a_basic_w_cookie.t ├── 003_basic_w_file_store.t ├── 003a_basic_w_file_store.t ├── 004_basic_file_w_customs.t ├── 004a_basic_file_w_customs.t ├── 005_basic_w_cache_store.t ├── 005a_basic_w_cache_store.t ├── 006_basic_w_dbi_store.t ├── 010_middleware.t ├── 010a_middleware.t ├── 012_streaming.t ├── 013_cookiestore.t ├── 014_cookie_options.t ├── 015_cookie_options_mw.t ├── 016_cookiestore_w_customs.t ├── lib ├── TestSession.pm └── TestSessionHash.pm └── tmp └── .gitignore /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | MANIFEST.SKIP 3 | META\.* 4 | MYMETA\.* 5 | *~ 6 | /plack-middleware-session-* 7 | /.build 8 | /_build_params 9 | /Build 10 | !Build/ 11 | !META.json 12 | /blib 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: perl 3 | perl: 4 | - "5.20" 5 | - 5.18 6 | env: AUTOMATED_TESTING=1 7 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | # This Build.PL for Plack-Middleware-Session was generated by Dist::Zilla::Plugin::ModuleBuildTiny 0.015. 2 | use strict; 3 | use warnings; 4 | 5 | use 5.006; 6 | use Module::Build::Tiny 0.034; 7 | Build_PL(); 8 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl extension Plack::Middleware::Session 2 | 3 | {{$NEXT}} 4 | 5 | 0.34 2024-09-23 09:54:12 PDT 6 | - Add support for Partitioned cookies (CHIP) #51 7 | 8 | 0.33 2019-03-09 15:18:15 PST 9 | - Removed dependency to Digest::SHA1 #45 10 | - Added explicit dep to HTTP::Request::Common #44 11 | - Add t/lib to INC for Perl 5.26+ 12 | - Fix POD link 13 | 14 | 0.32 2019-02-26 14:36:19 MST 15 | - Fix dependency for Cookie::Baker 16 | 17 | 0.31 2019-02-26 12:01:00 MST 18 | - Documentation fix 19 | - Support samesite cookie attributes #42 20 | 21 | 0.30 2015-03-02 10:24:38 PST 22 | - Fix VERSION 23 | 24 | 0.29 2015-02-17 15:56:25 PST 25 | - Moved repo to the plack organization on github 26 | 27 | 0.28 2015-02-16 08:30:08 PST 28 | - Same as 0.27. Make it non-trial 29 | 30 | 0.27 2015-02-13 16:52:11 PST 31 | - Added late_store in psgix.session.options to update the session after the streaming 32 | and reverts the default behavior to pre-0.26 (reported by darkkar, fixed by alexmv) #29, #30 33 | 34 | 0.26 2015-02-03 09:17:38 CET 35 | - Improved documentation (oalders, basiliscos, Mohammad Anwar, alexmv) 36 | - Session storage is now updated in the cleanup phase, after the streaming is complete (alexmv) #28 37 | 38 | 0.25 2014-09-28 20:07:42 PDT 39 | - Make tests safer for parallel execution. #21 40 | 41 | 0.24 2014-09-05 04:49:59 PDT 42 | - No changes since 0.23 43 | 44 | 0.23 2014-08-11 10:22:40 PDT 45 | - Changed the warning to error, when secret is not set. 46 | 47 | 0.22 2014-08-11 10:16:51 PDT 48 | - Document the vunlerability of using this middleware without secret, and 49 | warn when secret is not set on the runtime. In the next release the default 50 | will be changed to require the secret. (mala) 51 | 52 | 0.21 2013-10-12 11:41:37 PDT 53 | - use Cookie::Baker (kazeburo) 54 | 55 | 0.20 2013-06-24 16:09:21 PDT 56 | - Fix packaging (name casing) 57 | 58 | 0.19 2013-06-24 15:09:55 PDT 59 | - Use Milla 60 | - Add prereqs to LWP/HTTP::Cookies 61 | 62 | 0.18 Tue Feb 12 02:56:23 PST 2013 63 | - Repackaging 64 | 65 | 0.17 Mon Feb 11 15:40:50 PST 2013 66 | - Use constant time comparison of HMAC signature to be precautious for timing attacks 67 | 68 | 0.16 Sun Feb 10 11:41:14 PST 2013 69 | - Fix minimum version requirement for Test::Fatal 70 | 71 | 0.15 Tue Sep 4 14:15:13 PDT 2012 72 | - Fixed CPAN dependencies 73 | 74 | 0.14 Tue Mar 29 13:48:42 PDT 2011 75 | - Support get_dbh callback in Store::DBI (kazeburo) 76 | 77 | 0.13 Wed Dec 22 08:56:52 PST 2010 78 | - Added WARNINGS to deprecate request parameter based session state from the default state 79 | - Added 'change_id' option for paranoids against session fixation (s-aska, nihen) 80 | 81 | 0.12 Wed Jul 7 15:54:05 PDT 2010 82 | - Improved documents (markstos, haarg) 83 | - Support httponly option (haarg) 84 | 85 | 0.11 Sat Feb 27 02:40:29 PST 2010 86 | - Added Session::Store::DBI by lestrrat 87 | 88 | 0.10 Mon Feb 22 19:03:17 PST 2010 89 | - Make this a non-dev release now Plack 0.9910 is out 90 | 91 | 0.09_03 Tue Feb 2 20:42:56 PST 2010 92 | - Fixed so the default Cookie path is now correctly set to '/' 93 | You can override that by setting path = undef in psgix.session.options. 94 | (Reported by tomyhero) 95 | 96 | 0.09_02 Sat Jan 30 23:13:50 PST 2010 97 | - Fixed a bug in Cookie serialization where it breaks the response headers 98 | generated by applications (tomyhero) 99 | 100 | 0.09_01 Sat Jan 30 13:39:21 PST 2010 101 | - Reworked the internal code and API a lot, so Session persistence 102 | and retrieval are handled in a more stateless way 103 | - INCOMPATIBLE: psgix.session is now a hash reference rather than an object. 104 | If you need an object like before, do: 105 | use Plack::Session; $session = Plack::Session->new($env); 106 | - Added Plack::Middleware::Session::Cookie which uses CookieStore 107 | - Updated Cookie handling code to work with Plack 0.99 and later 108 | 109 | 0.03 Thurs. Jan. 7, 2009 110 | * Plack::Middleware::Session 111 | - change plack.session to psgix.session (plack.session is 112 | retained for back-compat, but is deprecated and will be 113 | removed in future versions) 114 | 115 | * Plack::Session::Store::File 116 | - changed to lock_* versions of the Storaable functions 117 | (thanks to Miyagawa) 118 | 119 | 0.02 Sat. Dec. 19, 2009 120 | - fixed dependency list (RT #52891) (Thanks to Andreas Koenig) 121 | - fixed some POD misspellings (Thanks to franckcuny) 122 | - fixed streaming interface (Thanks to clkao and miyagawa) 123 | 124 | 0.01 Tues. Dec. 15, 2009 125 | - Hello CPAN World! -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This software is copyright (c) 2009 by Tatsuhiko Miyagawa. 2 | 3 | This is free software; you can redistribute it and/or modify it under 4 | the same terms as the Perl 5 programming language system itself. 5 | 6 | Terms of the Perl programming language system itself 7 | 8 | a) the GNU General Public License as published by the Free 9 | Software Foundation; either version 1, or (at your option) any 10 | later version, or 11 | b) the "Artistic License" 12 | 13 | --- The GNU General Public License, Version 1, February 1989 --- 14 | 15 | This software is Copyright (c) 2009 by Tatsuhiko Miyagawa. 16 | 17 | This is free software, licensed under: 18 | 19 | The GNU General Public License, Version 1, February 1989 20 | 21 | GNU GENERAL PUBLIC LICENSE 22 | Version 1, February 1989 23 | 24 | Copyright (C) 1989 Free Software Foundation, Inc. 25 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 26 | 27 | Everyone is permitted to copy and distribute verbatim copies 28 | of this license document, but changing it is not allowed. 29 | 30 | Preamble 31 | 32 | The license agreements of most software companies try to keep users 33 | at the mercy of those companies. By contrast, our General Public 34 | License is intended to guarantee your freedom to share and change free 35 | software--to make sure the software is free for all its users. The 36 | General Public License applies to the Free Software Foundation's 37 | software and to any other program whose authors commit to using it. 38 | You can use it for your programs, too. 39 | 40 | When we speak of free software, we are referring to freedom, not 41 | price. Specifically, the General Public License is designed to make 42 | sure that you have the freedom to give away or sell copies of free 43 | software, that you receive source code or can get it if you want it, 44 | that you can change the software or use pieces of it in new free 45 | programs; and that you know you can do these things. 46 | 47 | To protect your rights, we need to make restrictions that forbid 48 | anyone to deny you these rights or to ask you to surrender the rights. 49 | These restrictions translate to certain responsibilities for you if you 50 | distribute copies of the software, or if you modify it. 51 | 52 | For example, if you distribute copies of a such a program, whether 53 | gratis or for a fee, you must give the recipients all the rights that 54 | you have. You must make sure that they, too, receive or can get the 55 | source code. And you must tell them their rights. 56 | 57 | We protect your rights with two steps: (1) copyright the software, and 58 | (2) offer you this license which gives you legal permission to copy, 59 | distribute and/or modify the software. 60 | 61 | Also, for each author's protection and ours, we want to make certain 62 | that everyone understands that there is no warranty for this free 63 | software. If the software is modified by someone else and passed on, we 64 | want its recipients to know that what they have is not the original, so 65 | that any problems introduced by others will not reflect on the original 66 | authors' reputations. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | GNU GENERAL PUBLIC LICENSE 72 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 73 | 74 | 0. This License Agreement applies to any program or other work which 75 | contains a notice placed by the copyright holder saying it may be 76 | distributed under the terms of this General Public License. The 77 | "Program", below, refers to any such program or work, and a "work based 78 | on the Program" means either the Program or any work containing the 79 | Program or a portion of it, either verbatim or with modifications. Each 80 | licensee is addressed as "you". 81 | 82 | 1. You may copy and distribute verbatim copies of the Program's source 83 | code as you receive it, in any medium, provided that you conspicuously and 84 | appropriately publish on each copy an appropriate copyright notice and 85 | disclaimer of warranty; keep intact all the notices that refer to this 86 | General Public License and to the absence of any warranty; and give any 87 | other recipients of the Program a copy of this General Public License 88 | along with the Program. You may charge a fee for the physical act of 89 | transferring a copy. 90 | 91 | 2. You may modify your copy or copies of the Program or any portion of 92 | it, and copy and distribute such modifications under the terms of Paragraph 93 | 1 above, provided that you also do the following: 94 | 95 | a) cause the modified files to carry prominent notices stating that 96 | you changed the files and the date of any change; and 97 | 98 | b) cause the whole of any work that you distribute or publish, that 99 | in whole or in part contains the Program or any part thereof, either 100 | with or without modifications, to be licensed at no charge to all 101 | third parties under the terms of this General Public License (except 102 | that you may choose to grant warranty protection to some or all 103 | third parties, at your option). 104 | 105 | c) If the modified program normally reads commands interactively when 106 | run, you must cause it, when started running for such interactive use 107 | in the simplest and most usual way, to print or display an 108 | announcement including an appropriate copyright notice and a notice 109 | that there is no warranty (or else, saying that you provide a 110 | warranty) and that users may redistribute the program under these 111 | conditions, and telling the user how to view a copy of this General 112 | Public License. 113 | 114 | d) You may charge a fee for the physical act of transferring a 115 | copy, and you may at your option offer warranty protection in 116 | exchange for a fee. 117 | 118 | Mere aggregation of another independent work with the Program (or its 119 | derivative) on a volume of a storage or distribution medium does not bring 120 | the other work under the scope of these terms. 121 | 122 | 3. You may copy and distribute the Program (or a portion or derivative of 123 | it, under Paragraph 2) in object code or executable form under the terms of 124 | Paragraphs 1 and 2 above provided that you also do one of the following: 125 | 126 | a) accompany it with the complete corresponding machine-readable 127 | source code, which must be distributed under the terms of 128 | Paragraphs 1 and 2 above; or, 129 | 130 | b) accompany it with a written offer, valid for at least three 131 | years, to give any third party free (except for a nominal charge 132 | for the cost of distribution) a complete machine-readable copy of the 133 | corresponding source code, to be distributed under the terms of 134 | Paragraphs 1 and 2 above; or, 135 | 136 | c) accompany it with the information you received as to where the 137 | corresponding source code may be obtained. (This alternative is 138 | allowed only for noncommercial distribution and only if you 139 | received the program in object code or executable form alone.) 140 | 141 | Source code for a work means the preferred form of the work for making 142 | modifications to it. For an executable file, complete source code means 143 | all the source code for all modules it contains; but, as a special 144 | exception, it need not include source code for modules which are standard 145 | libraries that accompany the operating system on which the executable 146 | file runs, or for standard header files or definitions files that 147 | accompany that operating system. 148 | 149 | 4. You may not copy, modify, sublicense, distribute or transfer the 150 | Program except as expressly provided under this General Public License. 151 | Any attempt otherwise to copy, modify, sublicense, distribute or transfer 152 | the Program is void, and will automatically terminate your rights to use 153 | the Program under this License. However, parties who have received 154 | copies, or rights to use copies, from you under this General Public 155 | License will not have their licenses terminated so long as such parties 156 | remain in full compliance. 157 | 158 | 5. By copying, distributing or modifying the Program (or any work based 159 | on the Program) you indicate your acceptance of this license to do so, 160 | and all its terms and conditions. 161 | 162 | 6. Each time you redistribute the Program (or any work based on the 163 | Program), the recipient automatically receives a license from the original 164 | licensor to copy, distribute or modify the Program subject to these 165 | terms and conditions. You may not impose any further restrictions on the 166 | recipients' exercise of the rights granted herein. 167 | 168 | 7. The Free Software Foundation may publish revised and/or new versions 169 | of the General Public License from time to time. Such new versions will 170 | be similar in spirit to the present version, but may differ in detail to 171 | address new problems or concerns. 172 | 173 | Each version is given a distinguishing version number. If the Program 174 | specifies a version number of the license which applies to it and "any 175 | later version", you have the option of following the terms and conditions 176 | either of that version or of any later version published by the Free 177 | Software Foundation. If the Program does not specify a version number of 178 | the license, you may choose any version ever published by the Free Software 179 | Foundation. 180 | 181 | 8. If you wish to incorporate parts of the Program into other free 182 | programs whose distribution conditions are different, write to the author 183 | to ask for permission. For software which is copyrighted by the Free 184 | Software Foundation, write to the Free Software Foundation; we sometimes 185 | make exceptions for this. Our decision will be guided by the two goals 186 | of preserving the free status of all derivatives of our free software and 187 | of promoting the sharing and reuse of software generally. 188 | 189 | NO WARRANTY 190 | 191 | 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 192 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 193 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 194 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 195 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 196 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 197 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 198 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 199 | REPAIR OR CORRECTION. 200 | 201 | 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 202 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 203 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 204 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 205 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 206 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 207 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 208 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 209 | POSSIBILITY OF SUCH DAMAGES. 210 | 211 | END OF TERMS AND CONDITIONS 212 | 213 | Appendix: How to Apply These Terms to Your New Programs 214 | 215 | If you develop a new program, and you want it to be of the greatest 216 | possible use to humanity, the best way to achieve this is to make it 217 | free software which everyone can redistribute and change under these 218 | terms. 219 | 220 | To do so, attach the following notices to the program. It is safest to 221 | attach them to the start of each source file to most effectively convey 222 | the exclusion of warranty; and each file should have at least the 223 | "copyright" line and a pointer to where the full notice is found. 224 | 225 | 226 | Copyright (C) 19yy 227 | 228 | This program is free software; you can redistribute it and/or modify 229 | it under the terms of the GNU General Public License as published by 230 | the Free Software Foundation; either version 1, or (at your option) 231 | any later version. 232 | 233 | This program is distributed in the hope that it will be useful, 234 | but WITHOUT ANY WARRANTY; without even the implied warranty of 235 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 236 | GNU General Public License for more details. 237 | 238 | You should have received a copy of the GNU General Public License 239 | along with this program; if not, write to the Free Software 240 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA 241 | 242 | 243 | Also add information on how to contact you by electronic and paper mail. 244 | 245 | If the program is interactive, make it output a short notice like this 246 | when it starts in an interactive mode: 247 | 248 | Gnomovision version 69, Copyright (C) 19xx name of author 249 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 250 | This is free software, and you are welcome to redistribute it 251 | under certain conditions; type `show c' for details. 252 | 253 | The hypothetical commands `show w' and `show c' should show the 254 | appropriate parts of the General Public License. Of course, the 255 | commands you use may be called something other than `show w' and `show 256 | c'; they could even be mouse-clicks or menu items--whatever suits your 257 | program. 258 | 259 | You should also get your employer (if you work as a programmer) or your 260 | school, if any, to sign a "copyright disclaimer" for the program, if 261 | necessary. Here a sample; alter the names: 262 | 263 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 264 | program `Gnomovision' (a program to direct compilers to make passes 265 | at assemblers) written by James Hacker. 266 | 267 | , 1 April 1989 268 | Ty Coon, President of Vice 269 | 270 | That's all there is to it! 271 | 272 | 273 | --- The Artistic License 1.0 --- 274 | 275 | This software is Copyright (c) 2009 by Tatsuhiko Miyagawa. 276 | 277 | This is free software, licensed under: 278 | 279 | The Artistic License 1.0 280 | 281 | The Artistic License 282 | 283 | Preamble 284 | 285 | The intent of this document is to state the conditions under which a Package 286 | may be copied, such that the Copyright Holder maintains some semblance of 287 | artistic control over the development of the package, while giving the users of 288 | the package the right to use and distribute the Package in a more-or-less 289 | customary fashion, plus the right to make reasonable modifications. 290 | 291 | Definitions: 292 | 293 | - "Package" refers to the collection of files distributed by the Copyright 294 | Holder, and derivatives of that collection of files created through 295 | textual modification. 296 | - "Standard Version" refers to such a Package if it has not been modified, 297 | or has been modified in accordance with the wishes of the Copyright 298 | Holder. 299 | - "Copyright Holder" is whoever is named in the copyright or copyrights for 300 | the package. 301 | - "You" is you, if you're thinking about copying or distributing this Package. 302 | - "Reasonable copying fee" is whatever you can justify on the basis of media 303 | cost, duplication charges, time of people involved, and so on. (You will 304 | not be required to justify it to the Copyright Holder, but only to the 305 | computing community at large as a market that must bear the fee.) 306 | - "Freely Available" means that no fee is charged for the item itself, though 307 | there may be fees involved in handling the item. It also means that 308 | recipients of the item may redistribute it under the same conditions they 309 | received it. 310 | 311 | 1. You may make and give away verbatim copies of the source form of the 312 | Standard Version of this Package without restriction, provided that you 313 | duplicate all of the original copyright notices and associated disclaimers. 314 | 315 | 2. You may apply bug fixes, portability fixes and other modifications derived 316 | from the Public Domain or from the Copyright Holder. A Package modified in such 317 | a way shall still be considered the Standard Version. 318 | 319 | 3. You may otherwise modify your copy of this Package in any way, provided that 320 | you insert a prominent notice in each changed file stating how and when you 321 | changed that file, and provided that you do at least ONE of the following: 322 | 323 | a) place your modifications in the Public Domain or otherwise make them 324 | Freely Available, such as by posting said modifications to Usenet or an 325 | equivalent medium, or placing the modifications on a major archive site 326 | such as ftp.uu.net, or by allowing the Copyright Holder to include your 327 | modifications in the Standard Version of the Package. 328 | 329 | b) use the modified Package only within your corporation or organization. 330 | 331 | c) rename any non-standard executables so the names do not conflict with 332 | standard executables, which must also be provided, and provide a separate 333 | manual page for each non-standard executable that clearly documents how it 334 | differs from the Standard Version. 335 | 336 | d) make other distribution arrangements with the Copyright Holder. 337 | 338 | 4. You may distribute the programs of this Package in object code or executable 339 | form, provided that you do at least ONE of the following: 340 | 341 | a) distribute a Standard Version of the executables and library files, 342 | together with instructions (in the manual page or equivalent) on where to 343 | get the Standard Version. 344 | 345 | b) accompany the distribution with the machine-readable source of the Package 346 | with your modifications. 347 | 348 | c) accompany any non-standard executables with their corresponding Standard 349 | Version executables, giving the non-standard executables non-standard 350 | names, and clearly documenting the differences in manual pages (or 351 | equivalent), together with instructions on where to get the Standard 352 | Version. 353 | 354 | d) make other distribution arrangements with the Copyright Holder. 355 | 356 | 5. You may charge a reasonable copying fee for any distribution of this 357 | Package. You may charge any fee you choose for support of this Package. You 358 | may not charge a fee for this Package itself. However, you may distribute this 359 | Package in aggregate with other (possibly commercial) programs as part of a 360 | larger (possibly commercial) software distribution provided that you do not 361 | advertise this Package as a product of your own. 362 | 363 | 6. The scripts and library files supplied as input to or produced as output 364 | from the programs of this Package do not automatically fall under the copyright 365 | of this Package, but belong to whomever generated them, and may be sold 366 | commercially, and may be aggregated with this Package. 367 | 368 | 7. C or perl subroutines supplied by you and linked into this Package shall not 369 | be considered part of this Package. 370 | 371 | 8. The name of the Copyright Holder may not be used to endorse or promote 372 | products derived from this software without specific prior written permission. 373 | 374 | 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 375 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 376 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. 377 | 378 | The End 379 | 380 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "Middleware for session management", 3 | "author" : [ 4 | "Tatsuhiko Miyagawa" 5 | ], 6 | "dynamic_config" : 0, 7 | "generated_by" : "Dist::Milla version v1.0.22, Dist::Zilla version 6.025, CPAN::Meta::Converter version 2.150010", 8 | "license" : [ 9 | "perl_5" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : 2 14 | }, 15 | "name" : "Plack-Middleware-Session", 16 | "no_index" : { 17 | "directory" : [ 18 | "eg", 19 | "examples", 20 | "inc", 21 | "share", 22 | "t", 23 | "xt" 24 | ] 25 | }, 26 | "prereqs" : { 27 | "configure" : { 28 | "requires" : { 29 | "Module::Build::Tiny" : "0.034" 30 | } 31 | }, 32 | "develop" : { 33 | "requires" : { 34 | "Dist::Milla" : "v1.0.22", 35 | "Test::Pod" : "1.41" 36 | } 37 | }, 38 | "runtime" : { 39 | "requires" : { 40 | "Cookie::Baker" : "0.12", 41 | "Digest::HMAC_SHA1" : "1.03", 42 | "Digest::SHA" : "0", 43 | "Plack" : "0.9910" 44 | } 45 | }, 46 | "test" : { 47 | "requires" : { 48 | "HTTP::Cookies" : "0", 49 | "HTTP::Request::Common" : "0", 50 | "LWP::UserAgent" : "0", 51 | "Test::Fatal" : "0.006", 52 | "Test::More" : "0.88", 53 | "Test::Requires" : "0" 54 | } 55 | } 56 | }, 57 | "release_status" : "stable", 58 | "resources" : { 59 | "bugtracker" : { 60 | "web" : "https://github.com/plack/Plack-Middleware-Session/issues" 61 | }, 62 | "homepage" : "https://github.com/plack/Plack-Middleware-Session", 63 | "repository" : { 64 | "type" : "git", 65 | "url" : "https://github.com/plack/Plack-Middleware-Session.git", 66 | "web" : "https://github.com/plack/Plack-Middleware-Session" 67 | } 68 | }, 69 | "version" : "0.34", 70 | "x_contributors" : [ 71 | "Alexander Kuehne ", 72 | "Alex Vandiver ", 73 | "cho45 ", 74 | "Christian Walde ", 75 | "Florian Schlichting ", 76 | "franck cuny ", 77 | "Graham Knop ", 78 | "Graham Knop ", 79 | "Ivan Baidakou ", 80 | "James E Keenan ", 81 | "John Lifsey ", 82 | "Lee Aylward ", 83 | "lestrrat ", 84 | "Mark Stosberg ", 85 | "Masahiro Chiba ", 86 | "Masahiro Nagano ", 87 | "Mohammad S Anwar ", 88 | "Olaf Alders ", 89 | "rawleyfowler ", 90 | "Rick Myers ", 91 | "s-aska ", 92 | "Stevan Little ", 93 | "Tatsuhiko Miyagawa ", 94 | "Tatsuhiko Miyagawa ", 95 | "Tokuhiro Matsuno ", 96 | "vividsnow " 97 | ], 98 | "x_generated_by_perl" : "v5.34.1", 99 | "x_serialization_backend" : "Cpanel::JSON::XS version 4.27", 100 | "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later", 101 | "x_static_install" : 1 102 | } 103 | 104 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # NAME 2 | 3 | Plack::Middleware::Session - Middleware for session management 4 | 5 | # SYNOPSIS 6 | 7 | use Plack::Builder; 8 | 9 | my $app = sub { 10 | my $env = shift; 11 | my $session = $env->{'psgix.session'}; 12 | return [ 13 | 200, 14 | [ 'Content-Type' => 'text/plain' ], 15 | [ "Hello, you've been here for ", $session->{counter}++, "th time!" ], 16 | ]; 17 | }; 18 | 19 | builder { 20 | enable 'Session'; 21 | $app; 22 | }; 23 | 24 | # Or, use the File store backend (great if you use multiprocess server) 25 | # For more options, see perldoc Plack::Session::Store::File 26 | builder { 27 | enable 'Session', store => 'File'; 28 | $app; 29 | }; 30 | 31 | # DESCRIPTION 32 | 33 | This is a Plack Middleware component for session management. By 34 | default it will use cookies to keep session state and store data in 35 | memory. This distribution also comes with other state and store 36 | solutions. See perldoc for these backends how to use them. 37 | 38 | It should be noted that we store the current session as a hash 39 | reference in the `psgix.session` key inside the `$env` where you can 40 | access it as needed. 41 | 42 | **NOTE:** As of version 0.04 the session is stored in `psgix.session` 43 | instead of `plack.session`. 44 | 45 | ## State 46 | 47 | - [Plack::Session::State](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AState) 48 | 49 | This will maintain session state by passing the session through 50 | the request params. It does not do this automatically though, 51 | you are responsible for passing the session param. 52 | 53 | - [Plack::Session::State::Cookie](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AState%3A%3ACookie) 54 | 55 | This will maintain session state using browser cookies. 56 | 57 | ## Store 58 | 59 | - [Plack::Session::Store](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore) 60 | 61 | This is your basic in-memory session data store. It is volatile storage 62 | and not recommended for multiprocessing environments. However it is 63 | very useful for development and testing. 64 | 65 | - [Plack::Session::Store::File](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore%3A%3AFile) 66 | 67 | This will persist session data in a file. By default it uses 68 | [Storable](https://metacpan.org/pod/Storable) but it can be configured to have a custom serializer and 69 | deserializer. 70 | 71 | - [Plack::Session::Store::Cache](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore%3A%3ACache) 72 | 73 | This will persist session data using the [Cache](https://metacpan.org/pod/Cache) interface. 74 | 75 | - [Plack::Session::Store::Null](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore%3A%3ANull) 76 | 77 | Sometimes you don't care about storing session data, in that case 78 | you can use this noop module. 79 | 80 | # OPTIONS 81 | 82 | The following are options that can be passed to this module. 83 | 84 | - _state_ 85 | 86 | This is expected to be an instance of [Plack::Session::State](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AState) or an 87 | object that implements the same interface. If no option is provided 88 | the default [Plack::Session::State::Cookie](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AState%3A%3ACookie) will be used. 89 | 90 | - _store_ 91 | 92 | This is expected to be an instance of [Plack::Session::Store](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore) or an 93 | object that implements the same interface. If no option is provided 94 | the default [Plack::Session::Store](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore) will be used. 95 | 96 | It should be noted that this default is an in-memory volatile store 97 | is only suitable for development (or single process servers). For a 98 | more robust solution see [Plack::Session::Store::File](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore%3A%3AFile) or 99 | [Plack::Session::Store::Cache](https://metacpan.org/pod/Plack%3A%3ASession%3A%3AStore%3A%3ACache). 100 | 101 | # PLACK REQUEST OPTIONS 102 | 103 | In addition to providing a `psgix.session` key in `$env` for 104 | persistent session information, this module also provides a 105 | `psgix.session.options` key which can be used to control the behavior 106 | of the module per-request. The following sub-keys exist: 107 | 108 | - _change\_id_ 109 | 110 | If set to a true value, forces the session identifier to change (rotate). This 111 | should always be done after logging in, to prevent session fixation 112 | attacks from subdomains; see 113 | [http://en.wikipedia.org/wiki/Session\_fixation#Attacks\_using\_cross-subdomain\_cooking](http://en.wikipedia.org/wiki/Session_fixation#Attacks_using_cross-subdomain_cooking) 114 | 115 | - _expire_ 116 | 117 | If set to a true value, expunges the session from the store, and clears 118 | the state in the client. 119 | 120 | - _no\_store_ 121 | 122 | If set to a true value, no changes made to the session in this request 123 | will be saved to the store. Either ["expire"](#expire) and ["change\_id"](#change_id) take 124 | precedence over this, as both need to update the session store. 125 | 126 | - _late\_store_ 127 | 128 | If set to a true value, the session will be saved at the _end_ of the 129 | request, after all data has been sent to the client -- this may be 130 | required if streaming responses attempt to alter the session after the 131 | header has already been sent to the client. Note, however, that it 132 | introduces a possible race condition, where the server attempts to store 133 | the updated session before the client makes the next request. For 134 | redirects, or other responses on which the client needs do minimal 135 | processing before making a second request, this race is quite possible 136 | to win -- causing the second request to obtain stale session data. 137 | 138 | - _id_ 139 | 140 | This key contains the session identifier of the session. It should be 141 | considered read-only; to generate a new identifier, use ["change\_id"](#change_id). 142 | 143 | # BUGS 144 | 145 | All complex software has bugs lurking in it, and this module is no 146 | exception. If you find a bug please either email me, or add the bug 147 | to cpan-RT. 148 | 149 | # AUTHOR 150 | 151 | Tatsuhiko Miyagawa 152 | 153 | Stevan Little 154 | 155 | # COPYRIGHT AND LICENSE 156 | 157 | Copyright 2009, 2010 Infinity Interactive, Inc. 158 | 159 | [http://www.iinteractive.com](http://www.iinteractive.com) 160 | 161 | This library is free software; you can redistribute it and/or modify 162 | it under the same terms as Perl itself. 163 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires 'Plack' => '0.9910'; 2 | requires 'Cookie::Baker' => '0.12'; 3 | 4 | # for session ID gen 5 | requires 'Digest::SHA' => '0'; 6 | requires 'Digest::HMAC_SHA1' => '1.03'; 7 | 8 | # things the tests need 9 | on test => sub { 10 | requires 'Test::More' => '0.88'; 11 | requires 'Test::Requires' => '0'; 12 | requires 'Test::Fatal', '0.006'; 13 | requires 'LWP::UserAgent'; 14 | requires 'HTTP::Cookies'; 15 | requires 'HTTP::Request::Common'; 16 | }; 17 | 18 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Plack-Middleware-Session 2 | [@Milla] 3 | 4 | -------------------------------------------------------------------------------- /examples/counter-raw.psgi: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # Simple counter web application 3 | 4 | # NOTE: This example uses Plack::Request to illustrate how 5 | # Plack::Middleware::Session interface ($env->{'psgix.session'}) could 6 | # be wrapped and integrated as part of the request API. See Tatsumaki 7 | # (integrated via subclassing Plack::Request) and Dancer::Session::PSGI 8 | # how to adapt Plack::Middleware::Session to web frameworks' APIs. 9 | 10 | # You're not recommended to write a new web application using this style. 11 | 12 | use strict; 13 | use Plack::Session; 14 | use Plack::Session::State; 15 | use Plack::Session::State::Cookie; 16 | use Plack::Session::Store; 17 | use Plack::Middleware::Session; 18 | 19 | my $app = Plack::Middleware::Session->wrap( 20 | sub { 21 | my $env = shift; 22 | my $r = Plack::Request->new( $env ); 23 | 24 | return [ 404, [], [] ] if $r->path_info =~ /favicon.ico/; 25 | 26 | my $session = $r->session; 27 | 28 | my $id = $session->id; 29 | my $counter = $session->get('counter') || 0; 30 | 31 | $session->set( 'counter' => $counter + 1 ); 32 | 33 | my $resp; 34 | 35 | if ( $r->param( 'logout' ) ) { 36 | $session->expire; 37 | $resp = $r->new_response; 38 | $resp->redirect( $r->path_info ); 39 | } 40 | else { 41 | $resp = $r->new_response( 42 | 200, 43 | [ 'Content-Type' => 'text/html' ], 44 | [ 45 | qq{ 46 | 47 | 48 | Plack::Middleware::Session Example 49 | 50 | 51 |

Session Id: ${id}

52 |

Counter: ${counter}

53 |
54 | Logout 55 | 56 | 57 | } 58 | ] 59 | ); 60 | } 61 | 62 | $resp->finalize; 63 | }, 64 | state => Plack::Session::State::Cookie->new, 65 | store => Plack::Session::Store->new, 66 | ); 67 | -------------------------------------------------------------------------------- /lib/Plack/Middleware/Session.pm: -------------------------------------------------------------------------------- 1 | package Plack::Middleware::Session; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use Plack::Util; 9 | use Scalar::Util; 10 | use Plack::Session::Cleanup; 11 | 12 | use parent 'Plack::Middleware'; 13 | 14 | use Plack::Util::Accessor qw( 15 | state 16 | store 17 | ); 18 | 19 | sub prepare_app { 20 | my $self = shift; 21 | 22 | $self->state( 'Cookie' ) unless $self->state; 23 | $self->state( $self->inflate_backend('Plack::Session::State', $self->state) ); 24 | $self->store( $self->inflate_backend('Plack::Session::Store', $self->store) ); 25 | } 26 | 27 | sub inflate_backend { 28 | my($self, $prefix, $backend) = @_; 29 | 30 | return $backend if defined $backend && Scalar::Util::blessed $backend; 31 | 32 | my @class; 33 | push @class, $backend if defined $backend; # undef means the root class 34 | push @class, $prefix; 35 | 36 | Plack::Util::load_class(@class)->new(); 37 | } 38 | 39 | sub call { 40 | my $self = shift; 41 | my $env = shift; 42 | 43 | my($id, $session) = $self->get_session($env); 44 | if ($id && $session) { 45 | $env->{'psgix.session'} = $session; 46 | } else { 47 | $id = $self->generate_id($env); 48 | $env->{'psgix.session'} = {}; 49 | } 50 | 51 | $env->{'psgix.session.options'} = { id => $id }; 52 | 53 | my $res = $self->app->($env); 54 | $self->response_cb($res, sub { $self->finalize($env, $_[0]) }); 55 | } 56 | 57 | sub get_session { 58 | my($self, $env) = @_; 59 | 60 | my $id = $self->state->extract($env) or return; 61 | my $session = $self->store->fetch($id) or return; 62 | 63 | return ($id, $session); 64 | } 65 | 66 | sub generate_id { 67 | my($self, $env) = @_; 68 | $self->state->generate($env); 69 | } 70 | 71 | sub commit { 72 | my($self, $env) = @_; 73 | 74 | my $session = $env->{'psgix.session'}; 75 | my $options = $env->{'psgix.session.options'}; 76 | 77 | my $end = sub { 78 | return if $options->{no_store}; 79 | $self->store->store($options->{id}, $session); 80 | }; 81 | 82 | if (not $options->{late_store}) { 83 | $end->(); 84 | } elsif ($env->{'psgix.cleanup'}) { 85 | push @{$env->{'psgix.cleanup.handlers'}}, $end; 86 | } else { 87 | $env->{'psgix.session.cleanup'} 88 | = Plack::Session::Cleanup->new($end); 89 | } 90 | } 91 | 92 | sub finalize { 93 | my($self, $env, $res) = @_; 94 | 95 | my $session = $env->{'psgix.session'}; 96 | my $options = $env->{'psgix.session.options'}; 97 | 98 | if ($options->{expire}) { 99 | $self->expire_session($options->{id}, $res, $env); 100 | } else { 101 | $self->change_id($env) if $options->{change_id}; 102 | $self->commit($env); 103 | $self->save_state($options->{id}, $res, $env); 104 | } 105 | } 106 | 107 | sub change_id { 108 | my($self, $env) = @_; 109 | 110 | my $options = $env->{'psgix.session.options'}; 111 | 112 | $self->store->remove($options->{id}); 113 | $options->{id} = $self->generate_id($env); 114 | } 115 | 116 | sub expire_session { 117 | my($self, $id, $res, $env) = @_; 118 | $self->store->remove($id); 119 | $self->state->expire_session_id($id, $res, $env->{'psgix.session.options'}); 120 | } 121 | 122 | sub save_state { 123 | my($self, $id, $res, $env) = @_; 124 | $self->state->finalize($id, $res, $env->{'psgix.session.options'}); 125 | } 126 | 127 | 1; 128 | 129 | __END__ 130 | 131 | =pod 132 | 133 | =head1 NAME 134 | 135 | Plack::Middleware::Session - Middleware for session management 136 | 137 | =head1 SYNOPSIS 138 | 139 | use Plack::Builder; 140 | 141 | my $app = sub { 142 | my $env = shift; 143 | my $session = $env->{'psgix.session'}; 144 | return [ 145 | 200, 146 | [ 'Content-Type' => 'text/plain' ], 147 | [ "Hello, you've been here for ", $session->{counter}++, "th time!" ], 148 | ]; 149 | }; 150 | 151 | builder { 152 | enable 'Session'; 153 | $app; 154 | }; 155 | 156 | # Or, use the File store backend (great if you use multiprocess server) 157 | # For more options, see perldoc Plack::Session::Store::File 158 | builder { 159 | enable 'Session', store => 'File'; 160 | $app; 161 | }; 162 | 163 | =head1 DESCRIPTION 164 | 165 | This is a Plack Middleware component for session management. By 166 | default it will use cookies to keep session state and store data in 167 | memory. This distribution also comes with other state and store 168 | solutions. See perldoc for these backends how to use them. 169 | 170 | It should be noted that we store the current session as a hash 171 | reference in the C key inside the C<$env> where you can 172 | access it as needed. 173 | 174 | B As of version 0.04 the session is stored in C 175 | instead of C. 176 | 177 | =head2 State 178 | 179 | =over 4 180 | 181 | =item L 182 | 183 | This will maintain session state by passing the session through 184 | the request params. It does not do this automatically though, 185 | you are responsible for passing the session param. 186 | 187 | =item L 188 | 189 | This will maintain session state using browser cookies. 190 | 191 | =back 192 | 193 | =head2 Store 194 | 195 | =over 4 196 | 197 | =item L 198 | 199 | This is your basic in-memory session data store. It is volatile storage 200 | and not recommended for multiprocessing environments. However it is 201 | very useful for development and testing. 202 | 203 | =item L 204 | 205 | This will persist session data in a file. By default it uses 206 | L but it can be configured to have a custom serializer and 207 | deserializer. 208 | 209 | =item L 210 | 211 | This will persist session data using the L interface. 212 | 213 | =item L 214 | 215 | Sometimes you don't care about storing session data, in that case 216 | you can use this noop module. 217 | 218 | =back 219 | 220 | =head1 OPTIONS 221 | 222 | The following are options that can be passed to this module. 223 | 224 | =over 4 225 | 226 | =item I 227 | 228 | This is expected to be an instance of L or an 229 | object that implements the same interface. If no option is provided 230 | the default L will be used. 231 | 232 | =item I 233 | 234 | This is expected to be an instance of L or an 235 | object that implements the same interface. If no option is provided 236 | the default L will be used. 237 | 238 | It should be noted that this default is an in-memory volatile store 239 | is only suitable for development (or single process servers). For a 240 | more robust solution see L or 241 | L. 242 | 243 | =back 244 | 245 | =head1 PLACK REQUEST OPTIONS 246 | 247 | In addition to providing a C key in C<$env> for 248 | persistent session information, this module also provides a 249 | C key which can be used to control the behavior 250 | of the module per-request. The following sub-keys exist: 251 | 252 | =over 253 | 254 | =item I 255 | 256 | If set to a true value, forces the session identifier to change (rotate). This 257 | should always be done after logging in, to prevent session fixation 258 | attacks from subdomains; see 259 | L 260 | 261 | =item I 262 | 263 | If set to a true value, expunges the session from the store, and clears 264 | the state in the client. 265 | 266 | =item I 267 | 268 | If set to a true value, no changes made to the session in this request 269 | will be saved to the store. Either L and L take 270 | precedence over this, as both need to update the session store. 271 | 272 | =item I 273 | 274 | If set to a true value, the session will be saved at the I of the 275 | request, after all data has been sent to the client -- this may be 276 | required if streaming responses attempt to alter the session after the 277 | header has already been sent to the client. Note, however, that it 278 | introduces a possible race condition, where the server attempts to store 279 | the updated session before the client makes the next request. For 280 | redirects, or other responses on which the client needs do minimal 281 | processing before making a second request, this race is quite possible 282 | to win -- causing the second request to obtain stale session data. 283 | 284 | =item I 285 | 286 | This key contains the session identifier of the session. It should be 287 | considered read-only; to generate a new identifier, use L. 288 | 289 | =back 290 | 291 | =head1 BUGS 292 | 293 | All complex software has bugs lurking in it, and this module is no 294 | exception. If you find a bug please either email me, or add the bug 295 | to cpan-RT. 296 | 297 | =head1 AUTHOR 298 | 299 | Tatsuhiko Miyagawa 300 | 301 | Stevan Little Estevan.little@iinteractive.comE 302 | 303 | =head1 COPYRIGHT AND LICENSE 304 | 305 | Copyright 2009, 2010 Infinity Interactive, Inc. 306 | 307 | L 308 | 309 | This library is free software; you can redistribute it and/or modify 310 | it under the same terms as Perl itself. 311 | 312 | =cut 313 | 314 | 315 | -------------------------------------------------------------------------------- /lib/Plack/Middleware/Session/Cookie.pm: -------------------------------------------------------------------------------- 1 | package Plack::Middleware::Session::Cookie; 2 | use strict; 3 | use parent qw(Plack::Middleware::Session); 4 | 5 | use Plack::Util::Accessor qw(secret session_key domain expires path secure httponly 6 | partitioned samesite serializer deserializer); 7 | 8 | use Digest::HMAC_SHA1; 9 | use MIME::Base64 (); 10 | use Storable (); 11 | use Time::HiRes; 12 | use Plack::Util; 13 | 14 | use Plack::Session::State::Cookie; 15 | 16 | sub prepare_app { 17 | my $self = shift; 18 | 19 | die "Plack::Session::Middleware::Cookie requires setting 'secret' option." 20 | unless $self->secret; 21 | 22 | $self->session_key("plack_session") unless $self->session_key; 23 | 24 | $self->serializer(sub {MIME::Base64::encode(Storable::nfreeze($_[0]), '' )}) 25 | unless $self->serializer; 26 | 27 | $self->deserializer(sub {Storable::thaw(MIME::Base64::decode($_[0]))}) 28 | unless $self->deserializer; 29 | 30 | $self->state( Plack::Session::State::Cookie->new ); 31 | for my $attr (qw(session_key path domain expires secure partitioned httponly samesite)) { 32 | $self->state->$attr($self->$attr); 33 | } 34 | } 35 | 36 | sub _compare { 37 | my($s1, $s2) = @_; 38 | 39 | return if length $s1 != length $s2; 40 | my $r = 0; 41 | for my $i (0..length($s1) - 1) { 42 | $r |= ord(substr $s1, $i) ^ ord(substr $s2, $i); 43 | } 44 | 45 | return $r == 0; 46 | } 47 | 48 | sub get_session { 49 | my($self, $request) = @_; 50 | 51 | my $cookie = $self->state->get_session_id($request) or return; 52 | 53 | my($time, $b64, $sig) = split /:/, $cookie, 3; 54 | _compare($self->sig($b64), $sig) or return; 55 | 56 | # NOTE: do something with $time? 57 | 58 | my $session = $self->deserializer->($b64); 59 | return ($self->generate_id, $session); 60 | } 61 | 62 | sub generate_id { 63 | my $self = shift; 64 | return scalar Time::HiRes::gettimeofday; 65 | } 66 | 67 | sub commit { } 68 | 69 | sub change_id { 70 | my($self, $env) = @_; 71 | 72 | my $options = $env->{'psgix.session.options'}; 73 | 74 | $options->{id} = $self->generate_id($env); 75 | } 76 | 77 | sub expire_session { 78 | my($self, $id, $res, $env) = @_; 79 | $self->state->expire_session_id($id, $res, $env->{'psgix.session.options'}); 80 | } 81 | 82 | sub save_state { 83 | my($self, $id, $res, $env) = @_; 84 | 85 | my $cookie = $self->_serialize($id, $env->{'psgix.session'}); 86 | $self->state->finalize($cookie, $res, $env->{'psgix.session.options'}); 87 | } 88 | 89 | sub _serialize { 90 | my($self, $id, $session) = @_; 91 | 92 | my $b64 = $self->serializer->($session); 93 | join ":", $id, $b64, $self->sig($b64); 94 | } 95 | 96 | sub sig { 97 | my($self, $b64) = @_; 98 | return '.' unless $self->secret; 99 | Digest::HMAC_SHA1::hmac_sha1_hex($b64, $self->secret); 100 | } 101 | 102 | 1; 103 | 104 | __END__ 105 | 106 | =head1 NAME 107 | 108 | Plack::Middleware::Session::Cookie - Session middleware that saves session data in the cookie 109 | 110 | =head1 SYNOPSIS 111 | 112 | enable 'Session::Cookie', 113 | session_key => 'my_session', 114 | expires => 3600, # 1 hour 115 | secret => 'top-secret' 116 | ; 117 | 118 | =head1 DESCRIPTION 119 | 120 | This middleware component allows you to use the cookie as a sole 121 | cookie state and store, without any server side storage to do the 122 | session management. This middleware utilizes its own state and store 123 | automatically for you, so you can't override the objects. 124 | 125 | =head1 CONFIGURATIONS 126 | 127 | This middleware is a subclass of L and 128 | accepts most configuration of the parent class. In addition, following 129 | options are accepted. 130 | 131 | =over 4 132 | 133 | =item secret 134 | 135 | Server side secret to sign the session data using HMAC SHA1. Defaults 136 | to nothing (i.e. do not sign) but B to set your 137 | own secret string. 138 | 139 | Unless you use your own serializer/deserializer, running this 140 | middleware without setting a secret is vulnerable to arbitrary code 141 | execution. B. 143 | 144 | =item session_key, domain, expires, path, secure, httponly, samesite 145 | 146 | Accessors for the cookie attributes. See 147 | L for these options. 148 | 149 | =back 150 | 151 | =head1 AUTHOR 152 | 153 | Tatsuhiko Miyagawa 154 | 155 | =head1 SEE ALSO 156 | 157 | L L 158 | 159 | =cut 160 | 161 | -------------------------------------------------------------------------------- /lib/Plack/Session.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use Plack::Util::Accessor qw( session options ); 9 | 10 | sub new { 11 | my ($class, $env) = @_; 12 | bless { 13 | session => $env->{'psgix.session'}, 14 | options => $env->{'psgix.session.options'}, 15 | }, $class; 16 | } 17 | 18 | sub id { 19 | my $self = shift; 20 | $self->options->{id}; 21 | } 22 | 23 | ## Data Managment 24 | 25 | sub dump { 26 | my $self = shift; 27 | $self->session; 28 | } 29 | 30 | sub get { 31 | my ($self, $key) = @_; 32 | $self->session->{$key}; 33 | } 34 | 35 | sub set { 36 | my ($self, $key, $value) = @_; 37 | delete $self->options->{no_store}; 38 | $self->session->{$key} = $value; 39 | } 40 | 41 | sub remove { 42 | my ($self, $key) = @_; 43 | delete $self->options->{no_store}; 44 | delete $self->session->{$key}; 45 | } 46 | 47 | sub keys { 48 | my $self = shift; 49 | keys %{$self->session}; 50 | } 51 | 52 | ## Lifecycle Management 53 | 54 | sub expire { 55 | my $self = shift; 56 | for my $key ($self->keys) { 57 | delete $self->session->{$key}; 58 | } 59 | $self->options->{expire} = 1; 60 | } 61 | 62 | 1; 63 | 64 | __END__ 65 | 66 | =pod 67 | 68 | =head1 NAME 69 | 70 | Plack::Session - Middleware for session management 71 | 72 | =head1 SYNOPSIS 73 | 74 | # Use with Middleware::Session 75 | enable "Session"; 76 | 77 | # later in your app 78 | use Plack::Session; 79 | my $app = sub { 80 | my $env = shift; 81 | my $session = Plack::Session->new($env); 82 | 83 | $session->id; 84 | $session->get($key); 85 | $session->set($key, $value); 86 | $session->remove($key); 87 | $session->keys; 88 | 89 | $session->expire; 90 | }; 91 | 92 | =head1 DESCRIPTION 93 | 94 | This is the core session object, you probably want to look 95 | at L, unless you are writing your 96 | own session middleware component. 97 | 98 | =head1 METHODS 99 | 100 | =over 4 101 | 102 | =item B 103 | 104 | The constructor takes a PSGI request env hash reference. 105 | 106 | =item B 107 | 108 | This is the accessor for the session id. 109 | 110 | =back 111 | 112 | =head2 Session Data Management 113 | 114 | These methods allows you to read and write the session data like 115 | Perl's normal hash. 116 | 117 | =over 4 118 | 119 | =item B 120 | 121 | =item B 122 | 123 | =item B 124 | 125 | =item B 126 | 127 | =item B, B 128 | 129 | =back 130 | 131 | =head2 Session Lifecycle Management 132 | 133 | =over 4 134 | 135 | =item B 136 | 137 | This method can be called to expire the current session id. 138 | 139 | =back 140 | 141 | =head1 BUGS 142 | 143 | All complex software has bugs lurking in it, and this module is no 144 | exception. If you find a bug please either email me, or add the bug 145 | to cpan-RT. 146 | 147 | =head1 AUTHOR 148 | 149 | Stevan Little Estevan.little@iinteractive.comE 150 | 151 | =head1 COPYRIGHT AND LICENSE 152 | 153 | Copyright 2009, 2010 Infinity Interactive, Inc. 154 | 155 | L 156 | 157 | This library is free software; you can redistribute it and/or modify 158 | it under the same terms as Perl itself. 159 | 160 | =cut 161 | 162 | -------------------------------------------------------------------------------- /lib/Plack/Session/Cleanup.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::Cleanup; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | sub new { 9 | my $class = shift; 10 | my $subref = shift; 11 | my $self = bless $subref, $class; 12 | return $self; 13 | } 14 | 15 | sub DESTROY { 16 | my $self = shift; 17 | $self->(); 18 | } 19 | 20 | 1; 21 | 22 | __END__ 23 | 24 | =pod 25 | 26 | =head1 NAME 27 | 28 | Plack::Session::Cleanup - Run code when the environment is destroyed 29 | 30 | =head1 SYNOPSIS 31 | 32 | $env->{'run_at_cleanup'} = Plack::Session::Cleanup->new( 33 | sub { 34 | # ... 35 | } 36 | ); 37 | 38 | 39 | =head1 DESCRIPTION 40 | 41 | This provides a way for L to run code when 42 | the environment is cleaned up. 43 | 44 | =head1 METHODS 45 | 46 | =over 4 47 | 48 | =item B 49 | 50 | Executes the given code reference when the object is C'd. Care 51 | should be taken that the given code reference does not close over 52 | C<$env>, creating a cycle and preventing the C<$env> from being 53 | destroyed. 54 | 55 | =back 56 | 57 | =cut 58 | -------------------------------------------------------------------------------- /lib/Plack/Session/State.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::State; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use Digest::SHA (); 9 | 10 | use Plack::Request; 11 | use Plack::Util::Accessor qw[ 12 | session_key 13 | sid_generator 14 | sid_validator 15 | ]; 16 | 17 | sub new { 18 | my ($class, %params) = @_; 19 | 20 | $params{'session_key'} ||= 'plack_session'; 21 | $params{'sid_generator'} ||= sub { 22 | Digest::SHA::sha1_hex(rand() . $$ . {} . time) 23 | }; 24 | $params{'sid_validator'} ||= qr/\A[0-9a-f]{40}\Z/; 25 | 26 | bless { %params } => $class; 27 | } 28 | 29 | sub expire_session_id { 30 | my ($self, $id, $res) = @_; 31 | } 32 | 33 | sub validate_session_id { 34 | my ($self, $id) = @_; 35 | $id =~ $self->sid_validator; 36 | } 37 | 38 | sub get_session_id { 39 | my ($self, $env) = @_; 40 | return Plack::Request->new($env)->param( $self->session_key ); 41 | } 42 | 43 | sub extract { 44 | my ($self, $env) = @_; 45 | 46 | my $id = $self->get_session_id( $env ); 47 | return unless defined $id; 48 | 49 | return $id if $self->validate_session_id( $id ); 50 | return; 51 | } 52 | 53 | sub generate { 54 | my $self = shift; 55 | $self->sid_generator->( @_ ); 56 | } 57 | 58 | 59 | sub finalize { 60 | my ($self, $id, $res, $options) = @_; 61 | (); 62 | } 63 | 64 | 1; 65 | 66 | __END__ 67 | 68 | =pod 69 | 70 | =head1 NAME 71 | 72 | Plack::Session::State - Basic parameter-based session state 73 | 74 | =head1 SYNOPSIS 75 | 76 | use Plack::Builder; 77 | use Plack::Middleware::Session; 78 | use Plack::Session::State; 79 | 80 | my $app = sub { 81 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 82 | }; 83 | 84 | builder { 85 | enable 'Session', 86 | state => Plack::Session::State->new; 87 | $app; 88 | }; 89 | 90 | =head1 DESCRIPTION 91 | 92 | This will maintain session state by passing the session through 93 | the request params. It does not do this automatically though, 94 | you are responsible for passing the session param. 95 | 96 | This should be considered the state "base" class (although 97 | subclassing is not a requirement) and defines the spec for 98 | all B modules. You will only 99 | need to override a couple methods if you do subclass. See 100 | L for an example of this. 101 | 102 | B: parameter based session ID management makes session 103 | fixation really easy, and that makes your website vulnerable. You 104 | should really avoid using this state in the production environment 105 | except when you have to deal with legacy HTTP clients that do not 106 | support cookies. 107 | 108 | In the future this parameter based state handling will be removed from 109 | this base class and will be moved to its own State class. 110 | 111 | =head1 METHODS 112 | 113 | =over 4 114 | 115 | =item B 116 | 117 | The C<%params> can include I, I and I 118 | however in both cases a default will be provided for you. 119 | 120 | =item B 121 | 122 | This is the name of the session key, it defaults to 'plack_session'. 123 | 124 | =item B 125 | 126 | This is a CODE ref used to generate unique session ids, by default 127 | it will generate a SHA1 using fairly sufficient entropy. If you are 128 | concerned or interested, just read the source. 129 | 130 | =item B 131 | 132 | This is a regex used to validate requested session id. 133 | 134 | =back 135 | 136 | =head2 Session ID Managment 137 | 138 | =over 4 139 | 140 | =item B 141 | 142 | This is the method used to extract the session id from a C<$env>. 143 | Subclasses will often only need to override this method and the 144 | C method. 145 | 146 | =item B 147 | 148 | This will use the C regex and confirm that the 149 | C<$session_id> is valid. 150 | 151 | =item B 152 | 153 | This will attempt to extract the session from a C<$env> by looking 154 | for the C in the request params. It will then check to 155 | see if the session is valid and that it has not expired. It will return 156 | the session id if everything is good or undef otherwise. 157 | 158 | =item B 159 | 160 | This will generate a new session id using the C callback. 161 | The C<$request> argument is not used by this method but is there for 162 | use by subclasses. The C<$request> is expected to be a L 163 | instance or an object with an equivalent interface. 164 | 165 | =item B 166 | 167 | Given a C<$session_id> and a C<$response> this will perform any 168 | finalization necessary to preserve state. This method is called by 169 | the L C method. The C<$response> is expected 170 | to be a L instance or an object with an equivalent 171 | interface. 172 | 173 | =back 174 | 175 | =head2 Session Expiration Handling 176 | 177 | =over 4 178 | 179 | =item B 180 | 181 | This will mark the session for C<$id> as expired. This method is called 182 | by the L C method. 183 | 184 | =back 185 | 186 | =head1 BUGS 187 | 188 | All complex software has bugs lurking in it, and this module is no 189 | exception. If you find a bug please either email me, or add the bug 190 | to cpan-RT. 191 | 192 | =head1 AUTHOR 193 | 194 | Stevan Little Estevan.little@iinteractive.comE 195 | 196 | =head1 COPYRIGHT AND LICENSE 197 | 198 | Copyright 2009, 2010 Infinity Interactive, Inc. 199 | 200 | L 201 | 202 | This library is free software; you can redistribute it and/or modify 203 | it under the same terms as Perl itself. 204 | 205 | =cut 206 | 207 | 208 | -------------------------------------------------------------------------------- /lib/Plack/Session/State/Cookie.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::State::Cookie; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use parent 'Plack::Session::State'; 9 | use Cookie::Baker; 10 | use Plack::Util; 11 | 12 | use Plack::Util::Accessor qw[ 13 | path 14 | domain 15 | expires 16 | secure 17 | httponly 18 | samesite 19 | partitioned 20 | ]; 21 | 22 | sub get_session_id { 23 | my ($self, $env) = @_; 24 | crush_cookie($env->{HTTP_COOKIE})->{$self->session_key}; 25 | } 26 | 27 | sub merge_options { 28 | my($self, %options) = @_; 29 | 30 | delete $options{id}; 31 | 32 | $options{path} = $self->path || '/' if !exists $options{path}; 33 | $options{domain} = $self->domain if !exists $options{domain} && defined $self->domain; 34 | $options{secure} = $self->secure if !exists $options{secure} && defined $self->secure; 35 | $options{httponly} = $self->httponly if !exists $options{httponly} && defined $self->httponly; 36 | $options{samesite} = $self->samesite if !exists $options{samesite} && defined $self->samesite; 37 | 38 | # https://developer.mozilla.org/en-US/docs/Web/Privacy/Privacy_sandbox/Partitioned_cookies 39 | $options{partitioned} = $self->partitioned if !exists $options{partitioned} && defined $self->partitioned; 40 | 41 | 42 | if (!exists $options{expires} && defined $self->expires) { 43 | $options{expires} = time + $self->expires; 44 | } 45 | 46 | if ($options{partitioned}) { 47 | $options{secure} = 1; 48 | $options{samesite} = 'None'; 49 | } 50 | 51 | return %options; 52 | } 53 | 54 | sub expire_session_id { 55 | my ($self, $id, $res, $options) = @_; 56 | my %opts = $self->merge_options(%$options, expires => time); 57 | $self->_set_cookie($id, $res, %opts); 58 | } 59 | 60 | sub finalize { 61 | my ($self, $id, $res, $options) = @_; 62 | my %opts = $self->merge_options(%$options); 63 | $self->_set_cookie($id, $res, %opts); 64 | } 65 | 66 | sub _set_cookie { 67 | my($self, $id, $res, %options) = @_; 68 | 69 | my $cookie = bake_cookie( 70 | $self->session_key, { 71 | value => $id, 72 | %options, 73 | } 74 | ); 75 | Plack::Util::header_push($res->[1], 'Set-Cookie', $cookie); 76 | } 77 | 78 | 1; 79 | 80 | __END__ 81 | 82 | =pod 83 | 84 | =head1 NAME 85 | 86 | Plack::Session::State::Cookie - Basic cookie-based session state 87 | 88 | =head1 SYNOPSIS 89 | 90 | use Plack::Builder; 91 | use Plack::Middleware::Session; 92 | 93 | my $app = sub { 94 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 95 | }; 96 | 97 | builder { 98 | enable 'Session'; # Cookie is the default state 99 | $app; 100 | }; 101 | 102 | =head1 DESCRIPTION 103 | 104 | This is a subclass of L and implements its 105 | full interface. This is the default state used in 106 | L. 107 | 108 | =head1 METHODS 109 | 110 | =over 4 111 | 112 | =item B 113 | 114 | The C<%params> can include I, I, I, I, 115 | and I options, as well as all the options accepted by 116 | L. 117 | 118 | =item B 119 | 120 | Path of the cookie, this defaults to "/"; 121 | 122 | =item B 123 | 124 | Domain of the cookie, if nothing is supplied then it will not 125 | be included in the cookie. 126 | 127 | =item B 128 | 129 | Expiration time of the cookie in seconds, if nothing is supplied then 130 | it will not be included in the cookie, which means the session expires 131 | per browser session. 132 | 133 | =item B 134 | 135 | Secure flag for the cookie, if nothing is supplied then it will not 136 | be included in the cookie. 137 | 138 | =item B 139 | 140 | HttpOnly flag for the cookie, if nothing is supplied then it will not 141 | be included in the cookie. 142 | 143 | =item B 144 | 145 | SameSite flag for the cookie, if nothing is supplied then it will not 146 | be included in the cookie. 147 | 148 | =back 149 | 150 | =head1 BUGS 151 | 152 | All complex software has bugs lurking in it, and this module is no 153 | exception. If you find a bug please either email me, or add the bug 154 | to cpan-RT. 155 | 156 | =head1 AUTHOR 157 | 158 | Stevan Little Estevan.little@iinteractive.comE 159 | 160 | =head1 COPYRIGHT AND LICENSE 161 | 162 | Copyright 2009, 2010 Infinity Interactive, Inc. 163 | 164 | L 165 | 166 | This library is free software; you can redistribute it and/or modify 167 | it under the same terms as Perl itself. 168 | 169 | =cut 170 | 171 | 172 | -------------------------------------------------------------------------------- /lib/Plack/Session/Store.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::Store; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use Plack::Util::Accessor qw[ _stash ]; 9 | 10 | sub new { 11 | my ($class, %params) = @_; 12 | $params{'_stash'} ||= +{}; 13 | bless { %params } => $class; 14 | } 15 | 16 | sub fetch { 17 | my ($self, $session_id) = @_; 18 | $self->_stash->{ $session_id }; 19 | } 20 | 21 | sub store { 22 | my ($self, $session_id, $session) = @_; 23 | $self->_stash->{ $session_id } = $session; 24 | } 25 | 26 | sub remove { 27 | my ($self, $session_id) = @_; 28 | delete $self->_stash->{ $session_id } 29 | } 30 | 31 | 1; 32 | 33 | __END__ 34 | 35 | =pod 36 | 37 | =head1 NAME 38 | 39 | Plack::Session::Store - Basic in-memory session store 40 | 41 | =head1 SYNOPSIS 42 | 43 | use Plack::Builder; 44 | use Plack::Middleware::Session; 45 | use Plack::Session::Store; 46 | 47 | my $app = sub { 48 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 49 | }; 50 | 51 | builder { 52 | enable 'Session'; # this is the default store 53 | $app; 54 | }; 55 | 56 | =head1 DESCRIPTION 57 | 58 | This is a very basic in-memory session data store. It is volatile 59 | storage and not recommended for multiprocessing environments. However 60 | it is very useful for development and testing. 61 | 62 | This should be considered the store "base" class (although 63 | subclassing is not a requirement) and defines the spec for 64 | all B modules. You will only 65 | need to override a couple methods if you do subclass. See 66 | the other B for examples of this. 67 | 68 | =head1 METHODS 69 | 70 | =over 4 71 | 72 | =item B 73 | 74 | No parameters are expected to this constructor. 75 | 76 | =back 77 | 78 | =head2 Session Data Management 79 | 80 | These methods fetch data from the session storage. It's designed to 81 | store or delete multiple keys at a time. 82 | 83 | =over 4 84 | 85 | =item B 86 | 87 | =item B 88 | 89 | =back 90 | 91 | =head2 Storage Management 92 | 93 | =over 4 94 | 95 | =item B 96 | 97 | This method is called by the L C method and 98 | is used to remove any session data. 99 | 100 | =back 101 | 102 | =head1 BUGS 103 | 104 | All complex software has bugs lurking in it, and this module is no 105 | exception. If you find a bug please either email me, or add the bug 106 | to cpan-RT. 107 | 108 | =head1 AUTHOR 109 | 110 | Stevan Little Estevan.little@iinteractive.comE 111 | 112 | =head1 COPYRIGHT AND LICENSE 113 | 114 | Copyright 2009, 2010 Infinity Interactive, Inc. 115 | 116 | L 117 | 118 | This library is free software; you can redistribute it and/or modify 119 | it under the same terms as Perl itself. 120 | 121 | =cut 122 | 123 | -------------------------------------------------------------------------------- /lib/Plack/Session/Store/Cache.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::Store::Cache; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use Scalar::Util qw[ blessed ]; 9 | 10 | use parent 'Plack::Session::Store'; 11 | 12 | use Plack::Util::Accessor qw[ cache ]; 13 | 14 | sub new { 15 | my ($class, %params) = @_; 16 | 17 | die('cache require get, set and remove method.') 18 | unless blessed $params{cache} 19 | && $params{cache}->can('get') 20 | && $params{cache}->can('set') 21 | && $params{cache}->can('remove'); 22 | 23 | bless { %params } => $class; 24 | } 25 | 26 | sub fetch { 27 | my ($self, $session_id ) = @_; 28 | $self->cache->get($session_id); 29 | } 30 | 31 | sub store { 32 | my ($self, $session_id, $session) = @_; 33 | $self->cache->set($session_id => $session); 34 | } 35 | 36 | sub remove { 37 | my ($self, $session_id) = @_; 38 | $self->cache->remove($session_id); 39 | } 40 | 41 | 1; 42 | 43 | __END__ 44 | 45 | =pod 46 | 47 | =head1 NAME 48 | 49 | Plack::Session::Store::Cache - Cache session store 50 | 51 | =head1 SYNOPSIS 52 | 53 | use Plack::Builder; 54 | use Plack::Session::Store::Cache; 55 | use CHI; 56 | 57 | my $app = sub { 58 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 59 | }; 60 | 61 | builder { 62 | enable 'Session', 63 | store => Plack::Session::Store::Cache->new( 64 | cache => CHI->new(driver => 'FastMmap') 65 | ); 66 | $app; 67 | }; 68 | 69 | =head1 DESCRIPTION 70 | 71 | This will persist session data using any module which implements the 72 | L interface. This offers a lot of flexibility due to the many 73 | excellent L, L and L drivers available. 74 | 75 | This is a subclass of L and implements 76 | its full interface. 77 | 78 | =head1 METHODS 79 | 80 | =over 4 81 | 82 | =item B 83 | 84 | The constructor expects the I param to be an object instance 85 | which has the I, I, and I methods, it will throw an 86 | exception if that is not the case. 87 | 88 | =item B 89 | 90 | A simple accessor for the cache handle. 91 | 92 | =back 93 | 94 | =head1 BUGS 95 | 96 | All complex software has bugs lurking in it, and this module is no 97 | exception. If you find a bug please either email me, or add the bug 98 | to cpan-RT. 99 | 100 | =head1 AUTHOR 101 | 102 | Masahiro Chiba 103 | 104 | =cut 105 | -------------------------------------------------------------------------------- /lib/Plack/Session/Store/DBI.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::Store::DBI; 2 | use strict; 3 | use warnings; 4 | 5 | # XXX Is there a notion of auto-expiry? 6 | 7 | our $VERSION = '0.34'; 8 | our $AUTHORITY = 'cpan:STEVAN'; 9 | 10 | use MIME::Base64 (); 11 | use Storable (); 12 | 13 | use parent 'Plack::Session::Store'; 14 | 15 | use Plack::Util::Accessor qw[ dbh get_dbh table_name serializer deserializer ]; 16 | 17 | sub new { 18 | my ($class, %params) = @_; 19 | 20 | if (! $params{dbh} && ! $params{get_dbh}) { 21 | die "DBI instance or a callback was not available in the argument list"; 22 | } 23 | 24 | $params{table_name} ||= 'sessions'; 25 | $params{serializer} ||= 26 | sub { MIME::Base64::encode_base64( Storable::nfreeze( $_[0] ) ) }; 27 | $params{deserializer} ||= 28 | sub { Storable::thaw( MIME::Base64::decode_base64( $_[0] ) ) }; 29 | 30 | my $self = bless { %params }, $class; 31 | return $self; 32 | } 33 | 34 | sub _dbh { 35 | my $self =shift; 36 | ( exists $self->{get_dbh} ) ? $self->{get_dbh}->() : $self->{dbh}; 37 | } 38 | 39 | sub fetch { 40 | my ($self, $session_id) = @_; 41 | my $table_name = $self->{table_name}; 42 | my $dbh = $self->_dbh; 43 | my $sth = $dbh->prepare_cached("SELECT session_data FROM $table_name WHERE id = ?"); 44 | $sth->execute( $session_id ); 45 | my ($data) = $sth->fetchrow_array(); 46 | $sth->finish; 47 | return $data ? $self->deserializer->( $data ) : (); 48 | } 49 | 50 | sub store { 51 | my ($self, $session_id, $session) = @_; 52 | my $table_name = $self->{table_name}; 53 | 54 | # XXX To be honest, I feel like there should be a transaction 55 | # call here.... but Catalyst didn't have it, so I'm not so sure 56 | 57 | my $sth = $self->_dbh->prepare_cached("SELECT 1 FROM $table_name WHERE id = ?"); 58 | $sth->execute($session_id); 59 | 60 | # need to fetch. on some DBD's execute()'s return status and 61 | # rows() is not reliable 62 | my ($exists) = $sth->fetchrow_array(); 63 | 64 | $sth->finish; 65 | 66 | if ($exists) { 67 | my $sth = $self->_dbh->prepare_cached("UPDATE $table_name SET session_data = ? WHERE id = ?"); 68 | $sth->execute( $self->serializer->($session), $session_id ); 69 | } 70 | else { 71 | my $sth = $self->_dbh->prepare_cached("INSERT INTO $table_name (id, session_data) VALUES (?, ?)"); 72 | $sth->execute( $session_id , $self->serializer->($session) ); 73 | } 74 | 75 | } 76 | 77 | sub remove { 78 | my ($self, $session_id) = @_; 79 | my $table_name = $self->{table_name}; 80 | my $sth = $self->_dbh->prepare_cached("DELETE FROM $table_name WHERE id = ?"); 81 | $sth->execute( $session_id ); 82 | $sth->finish; 83 | } 84 | 85 | 1; 86 | 87 | __END__ 88 | 89 | =head1 NAME 90 | 91 | Plack::Session::Store::DBI - DBI-based session store 92 | 93 | =head1 SYNOPSIS 94 | 95 | use Plack::Builder; 96 | use Plack::Middleware::Session; 97 | use Plack::Session::Store::DBI; 98 | 99 | my $app = sub { 100 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 101 | }; 102 | 103 | builder { 104 | enable 'Session', 105 | store => Plack::Session::Store::DBI->new( 106 | dbh => DBI->connect( @connect_args ) 107 | ); 108 | $app; 109 | }; 110 | 111 | # set get_dbh callback for ondemand 112 | 113 | builder { 114 | enable 'Session', 115 | store => Plack::Session::Store::DBI->new( 116 | get_dbh => sub { DBI->connect( @connect_args ) } 117 | ); 118 | $app; 119 | }; 120 | 121 | # with custom serializer/deserializer 122 | 123 | builder { 124 | enable 'Session', 125 | store => Plack::Session::Store::DBI->new( 126 | dbh => DBI->connect( @connect_args ) 127 | # YAML takes its args in the opposite order 128 | serializer => sub { YAML::DumpFile( reverse @_ ) }, 129 | deserializer => sub { YAML::LoadFile( @_ ) }, 130 | ); 131 | $app; 132 | }; 133 | 134 | 135 | # use custom session table name 136 | 137 | builder { 138 | enable 'Session', 139 | store => Plack::Session::Store::DBI->new( 140 | dbh => DBI->connect( @connect_args ), 141 | table_name => 'my_session_table', 142 | ); 143 | $app; 144 | }; 145 | 146 | =head1 DESCRIPTION 147 | 148 | This implements a DBI based storage for session data. By 149 | default it will use L and L to serialize and 150 | deserialize the data, but this can be configured easily. 151 | 152 | This is a subclass of L and implements 153 | its full interface. 154 | 155 | =head1 SESSION TABLE SCHEMA 156 | 157 | Your session table must have at least the following schema structure: 158 | 159 | CREATE TABLE sessions ( 160 | id CHAR(72) PRIMARY KEY, 161 | session_data TEXT 162 | ); 163 | 164 | Note that MySQL TEXT fields only store 64KB, so if your session data 165 | will exceed that size you'll want to move to MEDIUMTEXT, MEDIUMBLOB, 166 | or larger. 167 | 168 | =head1 AUTHORS 169 | 170 | Many aspects of this module were partially based upon L 171 | 172 | Daisuke Maki 173 | 174 | =head1 COPYRIGHT AND LICENSE 175 | 176 | Copyright 2009, 2010 Daisuke Maki C<< >> 177 | 178 | This library is free software; you can redistribute it and/or modify 179 | it under the same terms as Perl itself. 180 | =cut 181 | 182 | -------------------------------------------------------------------------------- /lib/Plack/Session/Store/File.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::Store::File; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | use Storable (); 9 | use File::Spec (); 10 | 11 | use parent 'Plack::Session::Store'; 12 | 13 | use Plack::Util::Accessor qw[ 14 | dir 15 | serializer 16 | deserializer 17 | ]; 18 | 19 | sub new { 20 | my ($class, %params) = @_; 21 | 22 | $params{'dir'} ||= $ENV{TMPDIR} || File::Spec->tmpdir; 23 | 24 | die "Storage directory (" . $params{'dir'} . ") is not writeable" 25 | unless -w $params{'dir'}; 26 | 27 | $params{'serializer'} ||= sub { Storable::lock_nstore( @_ ) }; 28 | $params{'deserializer'} ||= sub { Storable::lock_retrieve( @_ ) }; 29 | 30 | bless { %params } => $class; 31 | } 32 | 33 | sub fetch { 34 | my ($self, $session_id) = @_; 35 | 36 | my $file_path = $self->_get_session_file_path( $session_id ); 37 | return unless -f $file_path; 38 | 39 | $self->deserializer->( $file_path ); 40 | } 41 | 42 | sub store { 43 | my ($self, $session_id, $session) = @_; 44 | my $file_path = $self->_get_session_file_path( $session_id ); 45 | $self->serializer->( $session, $file_path ); 46 | } 47 | 48 | sub remove { 49 | my ($self, $session_id) = @_; 50 | unlink $self->_get_session_file_path( $session_id ); 51 | } 52 | 53 | sub _get_session_file_path { 54 | my ($self, $session_id) = @_; 55 | $self->dir . '/' . $session_id; 56 | } 57 | 58 | 1; 59 | 60 | __END__ 61 | 62 | =pod 63 | 64 | =head1 NAME 65 | 66 | Plack::Session::Store::File - Basic file-based session store 67 | 68 | =head1 SYNOPSIS 69 | 70 | use Plack::Builder; 71 | use Plack::Middleware::Session; 72 | use Plack::Session::Store::File; 73 | 74 | my $app = sub { 75 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 76 | }; 77 | 78 | builder { 79 | enable 'Session', 80 | store => Plack::Session::Store::File->new( 81 | dir => '/path/to/sessions' 82 | ); 83 | $app; 84 | }; 85 | 86 | # with custom serializer/deserializer 87 | 88 | builder { 89 | enable 'Session', 90 | store => Plack::Session::Store::File->new( 91 | dir => '/path/to/sessions', 92 | # YAML takes it's args the opposite order 93 | serializer => sub { YAML::DumpFile( reverse @_ ) }, 94 | deserializer => sub { YAML::LoadFile( @_ ) }, 95 | ); 96 | $app; 97 | }; 98 | 99 | =head1 DESCRIPTION 100 | 101 | This implements a basic file based storage for session data. By 102 | default it will use L to serialize and deserialize the 103 | data, but this can be configured easily. 104 | 105 | This is a subclass of L and implements 106 | its full interface. 107 | 108 | =head1 METHODS 109 | 110 | =over 4 111 | 112 | =item B 113 | 114 | The C<%params> can include I, I and I 115 | options. It will check to be sure that the I is writeable for 116 | you. 117 | 118 | =item B 119 | 120 | This is the directory to store the session data files in, if nothing 121 | is provided then L's tmpdir() is used to determine the 122 | system's temp dir. 123 | 124 | =item B 125 | 126 | This is a CODE reference that implements the serialization logic. 127 | The CODE ref gets two arguments, the C<$value>, which is a HASH 128 | reference to be serialized, and the C<$file_path> to save it to. 129 | It is not expected to return anything. 130 | 131 | =item B 132 | 133 | This is a CODE reference that implements the deserialization logic. 134 | The CODE ref gets one argument, the C<$file_path> to load the data 135 | from. It is expected to return a HASH reference. 136 | 137 | =back 138 | 139 | =head1 BUGS 140 | 141 | All complex software has bugs lurking in it, and this module is no 142 | exception. If you find a bug please either email me, or add the bug 143 | to cpan-RT. 144 | 145 | =head1 AUTHOR 146 | 147 | Stevan Little Estevan.little@iinteractive.comE 148 | 149 | =head1 COPYRIGHT AND LICENSE 150 | 151 | Copyright 2009, 2010 Infinity Interactive, Inc. 152 | 153 | L 154 | 155 | This library is free software; you can redistribute it and/or modify 156 | it under the same terms as Perl itself. 157 | 158 | =cut 159 | 160 | -------------------------------------------------------------------------------- /lib/Plack/Session/Store/Null.pm: -------------------------------------------------------------------------------- 1 | package Plack::Session::Store::Null; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '0.34'; 6 | our $AUTHORITY = 'cpan:STEVAN'; 7 | 8 | sub new { bless {} => shift } 9 | sub fetch {} 10 | sub store {} 11 | sub remove {} 12 | 13 | 1; 14 | 15 | __END__ 16 | 17 | =pod 18 | 19 | =head1 NAME 20 | 21 | Plack::Session::Store::Null - Null store 22 | 23 | =head1 SYNOPSIS 24 | 25 | use Plack::Builder; 26 | use Plack::Middleware::Session; 27 | use Plack::Session::Store::Null; 28 | 29 | my $app = sub { 30 | return [ 200, [ 'Content-Type' => 'text/plain' ], [ 'Hello Foo' ] ]; 31 | }; 32 | 33 | builder { 34 | enable 'Session', 35 | store => Plack::Session::Store::Null->new; 36 | $app; 37 | }; 38 | 39 | =head1 DESCRIPTION 40 | 41 | Sometimes you don't want to store anything in your sessions, but 42 | L requires a C instance, so you can use this 43 | one and all methods will return null. 44 | 45 | This is a subclass of L and implements 46 | its full interface. 47 | 48 | =head1 BUGS 49 | 50 | All complex software has bugs lurking in it, and this module is no 51 | exception. If you find a bug please either email me, or add the bug 52 | to cpan-RT. 53 | 54 | =head1 AUTHOR 55 | 56 | Stevan Little Estevan.little@iinteractive.comE 57 | 58 | =head1 COPYRIGHT AND LICENSE 59 | 60 | Copyright 2009, 2010 Infinity Interactive, Inc. 61 | 62 | L 63 | 64 | This library is free software; you can redistribute it and/or modify 65 | it under the same terms as Perl itself. 66 | 67 | =cut 68 | 69 | -------------------------------------------------------------------------------- /t/000_load.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use_ok( $_ ) || BAIL_OUT foreach qw[ 9 | Plack::Middleware::Session 10 | Plack::Session 11 | Plack::Session::Store 12 | Plack::Session::Store::Cache 13 | Plack::Session::Store::File 14 | Plack::Session::State 15 | Plack::Session::State::Cookie 16 | ]; 17 | 18 | done_testing; 19 | -------------------------------------------------------------------------------- /t/001_basic.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Plack::Request; 9 | use Plack::Session; 10 | use Plack::Session::State; 11 | use Plack::Session::Store; 12 | 13 | use lib "t/lib"; 14 | use TestSession; 15 | 16 | TestSession::run_all_tests( 17 | store => Plack::Session::Store->new, 18 | state => Plack::Session::State->new, 19 | env_cb => sub { 20 | open my $in, '<', \do { my $d }; 21 | my $env = { 22 | 'psgi.version' => [ 1, 0 ], 23 | 'psgi.input' => $in, 24 | 'psgi.errors' => *STDERR, 25 | 'psgi.url_scheme' => 'http', 26 | SERVER_PORT => 80, 27 | REQUEST_METHOD => 'GET', 28 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 29 | }; 30 | }, 31 | ); 32 | 33 | done_testing; 34 | -------------------------------------------------------------------------------- /t/001a_basic.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Plack::Request; 9 | use Plack::Session::State; 10 | use Plack::Session::Store; 11 | 12 | use lib "t/lib"; 13 | use TestSessionHash; 14 | 15 | TestSessionHash::run_all_tests( 16 | store => Plack::Session::Store->new, 17 | state => Plack::Session::State->new, 18 | env_cb => sub { 19 | open my $in, '<', \do { my $d }; 20 | my $env = { 21 | 'psgi.version' => [ 1, 0 ], 22 | 'psgi.input' => $in, 23 | 'psgi.errors' => *STDERR, 24 | 'psgi.url_scheme' => 'http', 25 | SERVER_PORT => 80, 26 | REQUEST_METHOD => 'GET', 27 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 28 | }; 29 | }, 30 | ); 31 | 32 | done_testing; 33 | -------------------------------------------------------------------------------- /t/002_basic_w_cookie.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Plack::Request; 9 | use Plack::Session; 10 | use Plack::Session::State::Cookie; 11 | use Plack::Session::Store; 12 | use Plack::Util; 13 | 14 | use lib "t/lib"; 15 | use TestSession; 16 | 17 | TestSession::run_all_tests( 18 | store => Plack::Session::Store->new, 19 | state => Plack::Session::State::Cookie->new, 20 | env_cb => sub { 21 | my $cookies = shift; 22 | open my $in, '<', \do { my $d }; 23 | my $env = { 24 | 'psgi.version' => [ 1, 0 ], 25 | 'psgi.input' => $in, 26 | 'psgi.errors' => *STDERR, 27 | 'psgi.url_scheme' => 'http', 28 | SERVER_PORT => 80, 29 | REQUEST_METHOD => 'GET', 30 | HTTP_COOKIE => join "; " => map { $_ . "=" . $cookies->{ $_ } } keys %$cookies, 31 | }; 32 | }, 33 | response_test => sub { 34 | my ($res_cb, $session_id, $check_expired) = @_; 35 | my $cookie; 36 | $res_cb->(sub { 37 | my $res = shift; 38 | $cookie = Plack::Util::header_get($res->[1], 'Set-Cookie'); 39 | }); 40 | 41 | like($cookie, qr/plack_session=$session_id/, '... cookie value is as suspected'); 42 | if ($check_expired) { 43 | like($cookie, qr/expires=/, '... cookie is expriring as suspected'); 44 | } 45 | } 46 | ); 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/002a_basic_w_cookie.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Plack::Request; 9 | use Plack::Session::State::Cookie; 10 | use Plack::Session::Store; 11 | use Plack::Util; 12 | 13 | use lib "t/lib"; 14 | use TestSessionHash; 15 | 16 | TestSessionHash::run_all_tests( 17 | store => Plack::Session::Store->new, 18 | state => Plack::Session::State::Cookie->new, 19 | env_cb => sub { 20 | my $cookies = shift; 21 | open my $in, '<', \do { my $d }; 22 | my $env = { 23 | 'psgi.version' => [ 1, 0 ], 24 | 'psgi.input' => $in, 25 | 'psgi.errors' => *STDERR, 26 | 'psgi.url_scheme' => 'http', 27 | SERVER_PORT => 80, 28 | REQUEST_METHOD => 'GET', 29 | HTTP_COOKIE => join "; " => map { $_ . "=" . $cookies->{ $_ } } keys %$cookies, 30 | }; 31 | }, 32 | response_test => sub { 33 | my ($res_cb, $session_id, $check_expired) = @_; 34 | my $cookie; 35 | $res_cb->(sub { 36 | my $res = shift; 37 | $cookie = Plack::Util::header_get($res->[1], 'Set-Cookie'); 38 | }); 39 | 40 | like($cookie, qr/plack_session=$session_id/, '... cookie value is as suspected'); 41 | if ($check_expired) { 42 | like($cookie, qr/expires=/, '... cookie is expriring as suspected'); 43 | } 44 | } 45 | ); 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/003_basic_w_file_store.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use File::Spec; 6 | use File::Temp qw(tempdir); 7 | 8 | use Test::More; 9 | 10 | use Plack::Request; 11 | use Plack::Session; 12 | use Plack::Session::State::Cookie; 13 | use Plack::Session::Store::File; 14 | 15 | use lib "t/lib"; 16 | use TestSession; 17 | 18 | my $tmp = tempdir(CLEANUP => 1); 19 | 20 | TestSession::run_all_tests( 21 | store => Plack::Session::Store::File->new( dir => $tmp ), 22 | state => Plack::Session::State->new, 23 | env_cb => sub { 24 | open my $in, '<', \do { my $d }; 25 | my $env = { 26 | 'psgi.version' => [ 1, 0 ], 27 | 'psgi.input' => $in, 28 | 'psgi.errors' => *STDERR, 29 | 'psgi.url_scheme' => 'http', 30 | SERVER_PORT => 80, 31 | REQUEST_METHOD => 'GET', 32 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 33 | }; 34 | }, 35 | ); 36 | 37 | done_testing; 38 | -------------------------------------------------------------------------------- /t/003a_basic_w_file_store.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use File::Spec; 6 | use File::Temp qw(tempdir); 7 | 8 | use Test::More; 9 | 10 | use Plack::Request; 11 | use Plack::Session::State::Cookie; 12 | use Plack::Session::Store::File; 13 | 14 | use lib "t/lib"; 15 | use TestSessionHash; 16 | 17 | my $tmp = tempdir(CLEANUP => 1); 18 | 19 | TestSessionHash::run_all_tests( 20 | store => Plack::Session::Store::File->new( dir => $tmp ), 21 | state => Plack::Session::State->new, 22 | env_cb => sub { 23 | open my $in, '<', \do { my $d }; 24 | my $env = { 25 | 'psgi.version' => [ 1, 0 ], 26 | 'psgi.input' => $in, 27 | 'psgi.errors' => *STDERR, 28 | 'psgi.url_scheme' => 'http', 29 | SERVER_PORT => 80, 30 | REQUEST_METHOD => 'GET', 31 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 32 | }; 33 | }, 34 | ); 35 | 36 | done_testing; 37 | -------------------------------------------------------------------------------- /t/004_basic_file_w_customs.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use File::Spec; 6 | use File::Temp qw(tempdir); 7 | use Test::Requires 'YAML'; 8 | 9 | use Test::More; 10 | 11 | use Plack::Request; 12 | use Plack::Session; 13 | use Plack::Session::State::Cookie; 14 | use Plack::Session::Store::File; 15 | 16 | use lib "t/lib"; 17 | use TestSession; 18 | 19 | my $tmp = tempdir(CLEANUP => 1); 20 | 21 | TestSession::run_all_tests( 22 | store => Plack::Session::Store::File->new( 23 | dir => $tmp, 24 | serializer => sub { YAML::DumpFile( reverse @_ ) }, # YAML takes it's args the opposite of Storable 25 | deserializer => sub { YAML::LoadFile( @_ ) }, 26 | ), 27 | state => Plack::Session::State->new, 28 | env_cb => sub { 29 | open my $in, '<', \do { my $d }; 30 | my $env = { 31 | 'psgi.version' => [ 1, 0 ], 32 | 'psgi.input' => $in, 33 | 'psgi.errors' => *STDERR, 34 | 'psgi.url_scheme' => 'http', 35 | SERVER_PORT => 80, 36 | REQUEST_METHOD => 'GET', 37 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 38 | }; 39 | }, 40 | ); 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/004a_basic_file_w_customs.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use File::Spec; 6 | use File::Temp qw(tempdir); 7 | use Test::Requires 'YAML'; 8 | 9 | use Test::More; 10 | 11 | use Plack::Request; 12 | use Plack::Session::State::Cookie; 13 | use Plack::Session::Store::File; 14 | 15 | use lib "t/lib"; 16 | use TestSessionHash; 17 | 18 | my $tmp = tempdir(CLEANUP => 1); 19 | 20 | TestSessionHash::run_all_tests( 21 | store => Plack::Session::Store::File->new( 22 | dir => $tmp, 23 | serializer => sub { YAML::DumpFile( reverse @_ ) }, # YAML takes it's args the opposite of Storable 24 | deserializer => sub { YAML::LoadFile( @_ ) }, 25 | ), 26 | state => Plack::Session::State->new, 27 | env_cb => sub { 28 | open my $in, '<', \do { my $d }; 29 | my $env = { 30 | 'psgi.version' => [ 1, 0 ], 31 | 'psgi.input' => $in, 32 | 'psgi.errors' => *STDERR, 33 | 'psgi.url_scheme' => 'http', 34 | SERVER_PORT => 80, 35 | REQUEST_METHOD => 'GET', 36 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 37 | }; 38 | }, 39 | ); 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/005_basic_w_cache_store.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Plack::Request; 9 | use Plack::Session; 10 | use Plack::Session::State; 11 | use Plack::Session::Store::Cache; 12 | 13 | use lib "t/lib"; 14 | use TestSession; 15 | 16 | { 17 | package TestCache; 18 | 19 | sub new { 20 | bless {} => shift; 21 | } 22 | 23 | sub set { 24 | my ($self, $key, $val ) = @_; 25 | 26 | $self->{$key} = $val; 27 | } 28 | 29 | sub get { 30 | my ($self, $key ) = @_; 31 | 32 | $self->{$key}; 33 | } 34 | 35 | sub remove { 36 | my ($self, $key ) = @_; 37 | 38 | delete $self->{$key}; 39 | } 40 | } 41 | 42 | TestSession::run_all_tests( 43 | store => Plack::Session::Store::Cache->new( cache => TestCache->new ), 44 | state => Plack::Session::State->new, 45 | env_cb => sub { 46 | open my $in, '<', \do { my $d }; 47 | my $env = { 48 | 'psgi.version' => [ 1, 0 ], 49 | 'psgi.input' => $in, 50 | 'psgi.errors' => *STDERR, 51 | 'psgi.url_scheme' => 'http', 52 | SERVER_PORT => 80, 53 | REQUEST_METHOD => 'GET', 54 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 55 | }; 56 | }, 57 | ); 58 | 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /t/005a_basic_w_cache_store.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Test::More; 7 | 8 | use Plack::Request; 9 | use Plack::Session::State; 10 | use Plack::Session::Store::Cache; 11 | 12 | use lib "t/lib"; 13 | use TestSessionHash; 14 | 15 | { 16 | package TestCache; 17 | 18 | sub new { 19 | bless {} => shift; 20 | } 21 | 22 | sub set { 23 | my ($self, $key, $val ) = @_; 24 | 25 | $self->{$key} = $val; 26 | } 27 | 28 | sub get { 29 | my ($self, $key ) = @_; 30 | 31 | $self->{$key}; 32 | } 33 | 34 | sub remove { 35 | my ($self, $key ) = @_; 36 | 37 | delete $self->{$key}; 38 | } 39 | } 40 | 41 | TestSessionHash::run_all_tests( 42 | store => Plack::Session::Store::Cache->new( cache => TestCache->new ), 43 | state => Plack::Session::State->new, 44 | env_cb => sub { 45 | open my $in, '<', \do { my $d }; 46 | my $env = { 47 | 'psgi.version' => [ 1, 0 ], 48 | 'psgi.input' => $in, 49 | 'psgi.errors' => *STDERR, 50 | 'psgi.url_scheme' => 'http', 51 | SERVER_PORT => 80, 52 | REQUEST_METHOD => 'GET', 53 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 54 | }; 55 | }, 56 | ); 57 | 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/006_basic_w_dbi_store.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use File::Spec; 6 | use File::Temp qw(tempdir); 7 | 8 | use Test::Requires qw(DBI DBD::SQLite MIME::Base64 Storable); 9 | use Test::More; 10 | 11 | use Plack::Request; 12 | use Plack::Session; 13 | use Plack::Session::State::Cookie; 14 | use Plack::Session::Store::DBI; 15 | 16 | use lib "t/lib"; 17 | use TestSession; 18 | 19 | my $tmp = tempdir(CLEANUP => 1); 20 | my $file = File::Spec->catfile($tmp, "006_basic_w_dbi_store.db"); 21 | my $dbh = DBI->connect( "dbi:SQLite:$file", undef, undef, {RaiseError => 1, AutoCommit => 1} ); 22 | $dbh->do(< Plack::Session::Store::DBI->new( dbh => $dbh ), 31 | state => Plack::Session::State->new, 32 | env_cb => sub { 33 | open my $in, '<', \do { my $d }; 34 | my $env = { 35 | 'psgi.version' => [ 1, 0 ], 36 | 'psgi.input' => $in, 37 | 'psgi.errors' => *STDERR, 38 | 'psgi.url_scheme' => 'http', 39 | SERVER_PORT => 80, 40 | REQUEST_METHOD => 'GET', 41 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 42 | }; 43 | }, 44 | ); 45 | 46 | TestSession::run_all_tests( 47 | store => Plack::Session::Store::DBI->new( get_dbh => sub { $dbh } ), 48 | state => Plack::Session::State->new, 49 | env_cb => sub { 50 | open my $in, '<', \do { my $d }; 51 | my $env = { 52 | 'psgi.version' => [ 1, 0 ], 53 | 'psgi.input' => $in, 54 | 'psgi.errors' => *STDERR, 55 | 'psgi.url_scheme' => 'http', 56 | SERVER_PORT => 80, 57 | REQUEST_METHOD => 'GET', 58 | QUERY_STRING => join "&" => map { $_ . "=" . $_[0]->{ $_ } } keys %{$_[0] || +{}}, 59 | }; 60 | }, 61 | ); 62 | 63 | 64 | $dbh->disconnect; 65 | 66 | done_testing; 67 | -------------------------------------------------------------------------------- /t/010_middleware.t: -------------------------------------------------------------------------------- 1 | use Plack::Test; 2 | use Plack::Middleware::Session; 3 | use Test::More; 4 | use HTTP::Request::Common; 5 | use HTTP::Cookies; 6 | 7 | my $app = sub { 8 | my $env = shift; 9 | my $counter = $env->{'psgix.session'}->{counter} || 0; 10 | 11 | my $body = "Counter=$counter"; 12 | $env->{'psgix.session'}->{counter} = $counter + 1; 13 | 14 | return [ 200, [ 'Content-Type', 'text/html' ], [ $body ] ]; 15 | }; 16 | 17 | $app = Plack::Middleware::Session->wrap($app); 18 | 19 | test_psgi $app, sub { 20 | my $cb = shift; 21 | 22 | my $jar = HTTP::Cookies->new; 23 | 24 | my $res = $cb->(GET "http://localhost/"); 25 | is $res->content_type, 'text/html'; 26 | is $res->content, "Counter=0"; 27 | $jar->extract_cookies($res); 28 | 29 | my $req = GET "http://localhost/"; 30 | $jar->add_cookie_header($req); 31 | $res = $cb->($req); 32 | is $res->content, "Counter=1"; 33 | }; 34 | 35 | done_testing; 36 | 37 | -------------------------------------------------------------------------------- /t/010a_middleware.t: -------------------------------------------------------------------------------- 1 | use Plack::Test; 2 | use Plack::Middleware::Session; 3 | use Test::More; 4 | use HTTP::Request::Common; 5 | use HTTP::Cookies; 6 | 7 | my $app = sub { 8 | my $env = shift; 9 | my $counter = $env->{'psgix.session'}->{'counter'} || 0; 10 | 11 | my $body = "Counter=$counter"; 12 | $counter++; 13 | $env->{'psgix.session'}->{counter} = $counter; 14 | 15 | return [ 200, [], [ $body ] ]; 16 | }; 17 | 18 | $app = Plack::Middleware::Session->wrap($app); 19 | 20 | test_psgi $app, sub { 21 | my $cb = shift; 22 | 23 | my $jar = HTTP::Cookies->new; 24 | 25 | my $res = $cb->(GET "http://localhost/"); 26 | is $res->content, "Counter=0"; 27 | $jar->extract_cookies($res); 28 | 29 | my $req = GET "http://localhost/"; 30 | $jar->add_cookie_header($req); 31 | $res = $cb->($req); 32 | is $res->content, "Counter=1"; 33 | }; 34 | 35 | done_testing; 36 | 37 | -------------------------------------------------------------------------------- /t/012_streaming.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use File::Temp qw(tempdir); 3 | use Test::More; 4 | use Plack::Test; 5 | use Plack::Middleware::Session; 6 | use Plack::Session::Store::File; 7 | use HTTP::Request::Common; 8 | use LWP::UserAgent; 9 | use HTTP::Cookies; 10 | 11 | $Plack::Test::Impl = 'Server'; 12 | 13 | my $base_app = sub { 14 | my $env = shift; 15 | return sub { 16 | my $respond = shift; 17 | 18 | # Enable late storage on the second request 19 | $env->{'psgix.session.options'}->{late_store} = 1 20 | if $env->{'psgix.session'}->{early}; 21 | 22 | $env->{'psgix.session'}->{early}++; 23 | my $w = $respond->([ 200, [ 'Content-Type' => 'text/html' ] ]); 24 | $w->write("Hello"); 25 | $env->{'psgix.session'}->{late}++; 26 | $w->close; 27 | }; 28 | }; 29 | 30 | my $tmp = tempdir(CLEANUP => 1); 31 | my $store = Plack::Session::Store::File->new( dir => $tmp ); 32 | my $app = Plack::Middleware::Session->wrap( $base_app, store => $store); 33 | 34 | my $ua = LWP::UserAgent->new; 35 | $ua->cookie_jar( HTTP::Cookies->new ); 36 | test_psgi ua => $ua, app => $app, client => sub { 37 | my $cb = shift; 38 | 39 | my $res = $cb->(GET "/"); 40 | is $res->content, "Hello"; 41 | like $res->header('Set-Cookie'), qr/plack_session/; 42 | 43 | my ($session_id) = $res->header('Set-Cookie') =~ /plack_session=([a-f0-9]+)/; 44 | ok $session_id, "Found session"; 45 | my $session = $store->fetch($session_id); 46 | ok $session, "Fetched session $session_id"; 47 | is $session->{early}, 1, "Early data is set"; 48 | is $session->{late}, undef, "Late data was lost, as late_store was not set"; 49 | 50 | $res = $cb->(GET "/"); 51 | is $res->content, "Hello"; 52 | like $res->header('Set-Cookie'), qr/plack_session/; 53 | $session = $store->fetch($session_id); 54 | ok $session, "Fetched session $session_id"; 55 | is $session->{early}, 2, "Early data is set"; 56 | is $session->{late}, 1, "Late data was stored"; 57 | }; 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/013_cookiestore.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | use Test::Requires qw(Digest::HMAC_SHA1); 4 | use Plack::Test; 5 | use Plack::Middleware::Session::Cookie; 6 | use HTTP::Request::Common; 7 | use LWP::UserAgent; 8 | use HTTP::Cookies; 9 | 10 | $Plack::Test::Impl = 'Server'; 11 | 12 | my $app = sub { 13 | my $env = shift; 14 | my $session = $env->{'psgix.session'}; 15 | 16 | my $counter = $session->{counter} || 0; 17 | if ($session->{counter}++ >= 2) { 18 | $env->{'psgix.session.options'}->{expire} = 1; 19 | } 20 | 21 | return [ 200, [], [ "counter=$counter" ] ]; 22 | }; 23 | 24 | $app = Plack::Middleware::Session::Cookie->wrap($app, secret => "foobar", expires => 3600); 25 | 26 | my $ua = LWP::UserAgent->new; 27 | $ua->cookie_jar( HTTP::Cookies->new ); 28 | 29 | test_psgi ua => $ua, app => $app, client => sub { 30 | my $cb = shift; 31 | 32 | my $res = $cb->(GET "/"); 33 | is $res->content, "counter=0"; 34 | like $res->header('Set-Cookie'), qr/expires=/; 35 | like $res->header('Set-Cookie'), qr/path=\//; 36 | 37 | $res = $cb->(GET "/"); 38 | is $res->content, "counter=1"; 39 | like $res->header('Set-Cookie'), qr/expires=/; 40 | 41 | $res = $cb->(GET "/"); 42 | is $res->content, "counter=2"; 43 | 44 | $res = $cb->(GET "/"); 45 | is $res->content, "counter=0"; 46 | }; 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/014_cookie_options.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | 4 | my $time = 1264843167; 5 | BEGIN { *CORE::GLOBAL::time = sub() { $time } } 6 | use Plack::Session::State::Cookie; 7 | 8 | my $st = Plack::Session::State::Cookie->new; 9 | $st->domain('.example.com'); 10 | $st->secure(1); 11 | $st->expires(3600); 12 | $st->path('/cgi-bin'); 13 | 14 | is_deeply +{ $st->merge_options(id => 123) }, 15 | { domain => '.example.com', secure => 1, expires => $time + 3600, path => '/cgi-bin' }; 16 | 17 | is_deeply +{ $st->merge_options(id => 123, path => '/', domain => '.perl.org') }, 18 | { domain => '.perl.org', secure => 1, expires => $time + 3600, path => '/' }; 19 | 20 | is_deeply +{ $st->merge_options(id => 123, expires => $time + 1, secure => 0, partitioned => 0) }, 21 | { domain => '.example.com', secure => 0, expires => $time + 1, path => '/cgi-bin', partitioned => 0 }; 22 | 23 | is_deeply +{ $st->merge_options(id => 123, expires => $time + 1, secure => 0, partitioned => 1) }, 24 | { domain => '.example.com', secure => 1, samesite => 'None', expires => $time + 1, path => '/cgi-bin', partitioned => 1 }; 25 | 26 | $st->partitioned(1); 27 | 28 | is_deeply +{ $st->merge_options(id => 123, expires => $time + 1, secure => 0) }, 29 | { domain => '.example.com', secure => 1, samesite => 'None', expires => $time + 1, path => '/cgi-bin', partitioned => 1 }; 30 | 31 | 32 | done_testing; 33 | -------------------------------------------------------------------------------- /t/015_cookie_options_mw.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Plack::Test; 3 | use Plack::Middleware::Session::Cookie; 4 | use Test::More; 5 | use HTTP::Request::Common; 6 | use HTTP::Cookies; 7 | 8 | my $app = sub { 9 | my $env = shift; 10 | 11 | $env->{'psgix.session'}->{counter} = 1; 12 | 13 | my $path = $env->{PATH_INFO} =~ /with_path/ ? "/foo" : undef; 14 | $env->{'psgix.session.options'}{path} = $path; 15 | $env->{'psgix.session.options'}{domain} = '.example.com'; 16 | 17 | return [ 200, [], [ "Hi" ] ]; 18 | }; 19 | 20 | $app = Plack::Middleware::Session::Cookie->wrap( 21 | $app, 22 | secret => 'foobar', 23 | httponly => 1, 24 | samesite => 'Lax', 25 | ); 26 | 27 | test_psgi $app, sub { 28 | my $cb = shift; 29 | 30 | my $res = $cb->(GET "http://localhost/"); 31 | like $res->header('Set-Cookie'), qr/plack_session=\S+; domain=.example.com; SameSite=Lax; HttpOnly/; 32 | 33 | $res = $cb->(GET "http://localhost/with_path"); 34 | like $res->header('Set-Cookie'), qr/plack_session=\S+; domain=.example.com; path=\/foo; SameSite=Lax; HttpOnly/; 35 | }; 36 | 37 | # Partitioned Cookies 38 | # https://developer.mozilla.org/en-US/docs/Web/Privacy/Privacy_sandbox/Partitioned_cookies 39 | $app = Plack::Middleware::Session::Cookie->wrap( 40 | $app, 41 | secret => 'foobar', 42 | httponly => 1, 43 | partitioned => 1 44 | ); 45 | 46 | test_psgi $app, sub { 47 | my $cb = shift; 48 | 49 | # Partitioned cookies are secure, and always have SameSite=None 50 | # Lowercase "secure" provided by Cookie::Baker when using Partitioned. 51 | my $res = $cb->(GET "http://localhost/"); 52 | like $res->header('Set-Cookie'), qr/plack_session=\S+; domain=.example.com; SameSite=None; secure; HttpOnly; Partitioned/; 53 | 54 | $res = $cb->(GET "http://localhost/with_path"); 55 | like $res->header('Set-Cookie'), qr/plack_session=\S+; domain=.example.com; path=\/foo; SameSite=None; secure; HttpOnly; Partitioned/; 56 | }; 57 | 58 | done_testing; 59 | 60 | -------------------------------------------------------------------------------- /t/016_cookiestore_w_customs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | use Test::Requires qw(Digest::HMAC_SHA1 YAML); 4 | use Plack::Test; 5 | use Plack::Middleware::Session::Cookie; 6 | use HTTP::Request::Common; 7 | use LWP::UserAgent; 8 | use HTTP::Cookies; 9 | 10 | $Plack::Test::Impl = 'Server'; 11 | 12 | my $app = sub { 13 | my $env = shift; 14 | my $session = $env->{'psgix.session'}; 15 | 16 | my $counter = $session->{counter} || 0; 17 | if ($session->{counter}++ >= 2) { 18 | $env->{'psgix.session.options'}->{expire} = 1; 19 | } 20 | 21 | return [ 200, [], [ "counter=$counter" ] ]; 22 | }; 23 | 24 | $app = Plack::Middleware::Session::Cookie->wrap( 25 | $app, 26 | secret => "foobar", 27 | expires => 3600, 28 | serializer => sub { MIME::Base64::encode(YAML::Dump($_[0])) }, 29 | deserializer => sub { YAML::Load(MIME::Base64::decode($_[0])) }, 30 | ); 31 | 32 | my $ua = LWP::UserAgent->new; 33 | $ua->cookie_jar( HTTP::Cookies->new ); 34 | 35 | test_psgi ua => $ua, app => $app, client => sub { 36 | my $cb = shift; 37 | 38 | my $res = $cb->(GET "/"); 39 | is $res->content, "counter=0"; 40 | like $res->header('Set-Cookie'), qr/expires=/; 41 | like $res->header('Set-Cookie'), qr/path=\//; 42 | 43 | $res = $cb->(GET "/"); 44 | is $res->content, "counter=1"; 45 | like $res->header('Set-Cookie'), qr/expires=/; 46 | 47 | $res = $cb->(GET "/"); 48 | is $res->content, "counter=2"; 49 | 50 | $res = $cb->(GET "/"); 51 | is $res->content, "counter=0"; 52 | }; 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/lib/TestSession.pm: -------------------------------------------------------------------------------- 1 | package TestSession; 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | use Test::Fatal qw(lives_ok); 7 | use Plack::Middleware::Session; 8 | use Plack::Session; 9 | 10 | sub create_session { 11 | my($mw, $env) = @_; 12 | 13 | my $session; 14 | my $app = sub { 15 | my $env = shift; 16 | $session = Plack::Session->new($env); 17 | return sub { 18 | my $responder = shift; 19 | $responder->([ 200, [], [] ]); 20 | }; 21 | }; 22 | 23 | my $res = $mw->($app)->($env); 24 | 25 | return ($session, $res); 26 | } 27 | 28 | sub run_all_tests { 29 | my %params = @_; 30 | 31 | my ( 32 | $env_cb, 33 | $state, 34 | $storage, 35 | $response_test 36 | ) = @params{qw[ 37 | env_cb 38 | state 39 | store 40 | response_test 41 | ]}; 42 | 43 | my $m = sub { Plack::Middleware::Session->wrap($_[0], state => $state, store => $storage) }; 44 | 45 | $response_test ||= sub { 46 | my($res_cb, $session_id, $check_expired) = @_; 47 | $res_cb->(sub { my $res = shift }); 48 | }; 49 | 50 | my @sids; 51 | { 52 | my($s, $res) = create_session($m, $env_cb->()); 53 | 54 | push @sids, $s->id; 55 | 56 | ok(!$s->get('foo'), '... no value stored in foo for session'); 57 | 58 | lives_ok { 59 | $s->set( foo => 'bar' ); 60 | } '... set the value successfully in session'; 61 | 62 | is($s->get('foo'), 'bar', '... got the foo value back successfully from session'); 63 | 64 | ok(!$s->get('bar'), '... no value stored in foo for session'); 65 | 66 | lives_ok { 67 | $s->set( bar => 'baz' ); 68 | } '... set the value successfully in session'; 69 | 70 | is($s->get('bar'), 'baz', '... got the foo value back successfully from session'); 71 | 72 | is_deeply( $s->dump, { foo => 'bar', bar => 'baz' }, '... got the session dump we expected'); 73 | 74 | $response_test->($res, $sids[0]); 75 | } 76 | 77 | { 78 | my($s, $res) = create_session($m, $env_cb->()); 79 | 80 | push @sids, $s->id; 81 | 82 | isnt($sids[0], $sids[1], "no same Session ID"); 83 | ok(!$s->get('foo'), '... no value stored for foo in session'); 84 | 85 | lives_ok { 86 | $s->set( foo => 'baz' ); 87 | } '... set the value successfully'; 88 | 89 | is($s->get('foo'), 'baz', '... got the foo value back successfully from session'); 90 | 91 | is_deeply( $s->dump, { foo => 'baz' }, '... got the session dump we expected'); 92 | 93 | $response_test->($res, $sids[1]); 94 | } 95 | 96 | { 97 | my($s, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 98 | is($s->id, $sids[0], '... got a basic session id'); 99 | 100 | is($s->get('foo'), 'bar', '... got the value for foo back successfully from session'); 101 | 102 | 103 | lives_ok { 104 | $s->remove( 'foo' ); 105 | } '... removed the foo value successfully from session'; 106 | 107 | ok(!$s->get('foo'), '... no value stored for foo in session'); 108 | 109 | is_deeply( $s->dump, { bar => 'baz' }, '... got the session dump we expected'); 110 | 111 | $response_test->( $res, $sids[0] ); 112 | } 113 | 114 | 115 | { 116 | my($s, $res) = create_session($m, $env_cb->({ plack_session => $sids[1] })); 117 | 118 | is($s->id, $sids[1], '... got a basic session id'); 119 | 120 | is($s->get('foo'), 'baz', '... got the foo value back successfully from session'); 121 | 122 | is_deeply( $s->dump, { foo => 'baz' }, '... got the session dump we expected'); 123 | 124 | $response_test->( $res, $sids[1] ); 125 | } 126 | 127 | { 128 | my($s, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 129 | 130 | is($s->id, $sids[0], '... got a basic session id'); 131 | 132 | ok(!$s->get('foo'), '... no value stored for foo in session'); 133 | 134 | lives_ok { 135 | $s->set( baz => 'gorch' ); 136 | } '... set the bar value successfully in session'; 137 | 138 | is_deeply( $s->dump, { bar => 'baz', baz => 'gorch' }, '... got the session dump we expected'); 139 | 140 | $response_test->( $res, $sids[0] ); 141 | } 142 | 143 | { 144 | my($s, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 145 | 146 | is($s->get('bar'), 'baz', '... got the bar value back successfully from session'); 147 | 148 | lives_ok { 149 | $s->expire; 150 | } '... expired session successfully'; 151 | 152 | $response_test->( $res, $sids[0], 1 ); 153 | 154 | is_deeply( $s->dump, {}, '... got the session dump we expected'); 155 | } 156 | 157 | { 158 | my($s, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 159 | 160 | push @sids, $s->id; 161 | isnt($s->id, $sids[0], 'expired ... got a new session id'); 162 | 163 | ok(!$s->get('bar'), '... no bar value stored'); 164 | 165 | is_deeply( $s->dump, {}, '... got the session dump we expected'); 166 | 167 | $response_test->( $res, $sids[2] ); 168 | } 169 | 170 | { 171 | my($s, $res) = create_session($m, $env_cb->({ plack_session => $sids[1] })); 172 | 173 | is($s->id, $sids[1], '... got a basic session id'); 174 | 175 | is($s->get('foo'), 'baz', '... got the foo value back successfully from session'); 176 | 177 | is_deeply( $s->dump, { foo => 'baz' }, '... got the session dump we expected'); 178 | 179 | $response_test->( $res, $sids[1] ); 180 | } 181 | 182 | { 183 | # wrong format session_id 184 | my($s, $res) = create_session($m, $env_cb->({ plack_session => "../wrong" })); 185 | 186 | isnt('../wrong' => $s->id, '... regenerate session id'); 187 | 188 | ok(!$s->get('foo'), '... no value stored for foo in session'); 189 | 190 | lives_ok { 191 | $s->set( foo => 'baz' ); 192 | } '... set the value successfully'; 193 | 194 | is($s->get('foo'), 'baz', '... got the foo value back successfully from session'); 195 | 196 | is_deeply( $s->dump, { foo => 'baz' }, '... got the session dump we expected'); 197 | 198 | $response_test->( $res, $s->id ); 199 | } 200 | } 201 | 202 | 1; 203 | -------------------------------------------------------------------------------- /t/lib/TestSessionHash.pm: -------------------------------------------------------------------------------- 1 | package TestSessionHash; 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | use Test::Fatal qw(lives_ok); 7 | use Plack::Middleware::Session; 8 | 9 | sub create_session { 10 | my($mw, $env) = @_; 11 | 12 | my ($session, $session_options); 13 | my $app = sub { 14 | my $env = shift; 15 | $session = $env->{'psgix.session'}; 16 | $session_options = $env->{'psgix.session.options'}; 17 | return sub { 18 | my $responder = shift; 19 | $responder->([ 200, [], [] ]); 20 | }; 21 | }; 22 | 23 | my $res = $mw->($app)->($env); 24 | 25 | return ($session, $session_options, $res); 26 | } 27 | 28 | sub run_all_tests { 29 | my %params = @_; 30 | 31 | my ( 32 | $env_cb, 33 | $state, 34 | $storage, 35 | $response_test, 36 | $middleware_create_cb 37 | ) = @params{qw[ 38 | env_cb 39 | state 40 | store 41 | response_test 42 | middleware_create_cb 43 | ]}; 44 | 45 | my $m = $middleware_create_cb 46 | || sub { Plack::Middleware::Session->wrap($_[0], state => $state, store => $storage) }; 47 | 48 | $response_test ||= sub { 49 | my($res_cb, $session_id, $check_expired) = @_; 50 | $res_cb->(sub { my $res = shift }); 51 | }; 52 | 53 | my @sids; 54 | { 55 | my($s, $opts, $res) = create_session($m, $env_cb->()); 56 | 57 | push @sids, $opts->{id}; 58 | 59 | ok(!$s->{'foo'}, '... no value stored in foo for session'); 60 | 61 | lives_ok { 62 | $s->{foo} = 'bar'; 63 | } '... set the value successfully in session'; 64 | 65 | is($s->{'foo'}, 'bar', '... got the foo value back successfully from session'); 66 | 67 | ok(!$s->{'bar'}, '... no value stored in foo for session'); 68 | 69 | lives_ok { 70 | $s->{bar} = 'baz'; 71 | } '... set the value successfully in session'; 72 | 73 | is($s->{'bar'}, 'baz', '... got the foo value back successfully from session'); 74 | 75 | is_deeply( $s, { foo => 'bar', bar => 'baz' }, '... got the session dump we expected'); 76 | 77 | $response_test->($res, $sids[0]); 78 | } 79 | 80 | { 81 | my($s, $opts, $res) = create_session($m, $env_cb->()); 82 | 83 | push @sids, $opts->{id}; 84 | 85 | isnt($sids[0], $sids[1], "no same Session ID"); 86 | ok(!$s->{'foo'}, '... no value stored for foo in session'); 87 | 88 | lives_ok { 89 | $s->{foo} = 'baz'; 90 | } '... set the value successfully'; 91 | 92 | is($s->{'foo'}, 'baz', '... got the foo value back successfully from session'); 93 | 94 | is_deeply( $s, { foo => 'baz' }, '... got the session dump we expected'); 95 | 96 | $response_test->($res, $sids[1]); 97 | } 98 | 99 | { 100 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 101 | is($opts->{id}, $sids[0], '... got a basic session id'); 102 | 103 | is($s->{'foo'}, 'bar', '... got the value for foo back successfully from session'); 104 | 105 | 106 | lives_ok { 107 | delete $s->{'foo'}; 108 | } '... removed the foo value successfully from session'; 109 | 110 | ok(!$s->{'foo'}, '... no value stored for foo in session'); 111 | 112 | is_deeply( $s, { bar => 'baz' }, '... got the session dump we expected'); 113 | 114 | $response_test->( $res, $sids[0] ); 115 | } 116 | 117 | 118 | { 119 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => $sids[1] })); 120 | 121 | is($opts->{id}, $sids[1], '... got a basic session id'); 122 | 123 | is($s->{'foo'}, 'baz', '... got the foo value back successfully from session'); 124 | 125 | is_deeply( $s, { foo => 'baz' }, '... got the session dump we expected'); 126 | 127 | $response_test->( $res, $sids[1] ); 128 | } 129 | 130 | { 131 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 132 | 133 | is($opts->{id}, $sids[0], '... got a basic session id'); 134 | 135 | ok(!$s->{'foo'}, '... no value stored for foo in session'); 136 | 137 | lives_ok { 138 | $s->{baz} = 'gorch'; 139 | } '... set the bar value successfully in session'; 140 | 141 | is_deeply( $s, { bar => 'baz', baz => 'gorch' }, '... got the session dump we expected'); 142 | 143 | $response_test->( $res, $sids[0] ); 144 | } 145 | 146 | { 147 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 148 | 149 | is($s->{'bar'}, 'baz', '... got the bar value back successfully from session'); 150 | 151 | lives_ok { 152 | $opts->{expire} = 1; 153 | } '... expired session successfully'; 154 | 155 | $response_test->( $res, $sids[0], 1 ); 156 | 157 | # XXX 158 | # this will not pass, because 159 | # it is just a hash ref and we are 160 | # not clearing it. Should we be? 161 | # - SL 162 | # is_deeply( $s, {}, '... got the session dump we expected'); 163 | } 164 | 165 | { 166 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => $sids[0] })); 167 | 168 | push @sids, $opts->{id}; 169 | isnt($opts->{id}, $sids[0], 'expired ... got a new session id'); 170 | 171 | ok(!$s->{'bar'}, '... no bar value stored'); 172 | 173 | is_deeply( $s, {}, '... got the session dump we expected'); 174 | 175 | $response_test->( $res, $sids[2] ); 176 | } 177 | 178 | { 179 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => $sids[1] })); 180 | 181 | is($opts->{id}, $sids[1], '... got a basic session id'); 182 | 183 | is($s->{'foo'}, 'baz', '... got the foo value back successfully from session'); 184 | 185 | is_deeply( $s, { foo => 'baz' }, '... got the session dump we expected'); 186 | 187 | $response_test->( $res, $sids[1] ); 188 | } 189 | 190 | { 191 | # wrong format session_id 192 | my($s, $opts, $res) = create_session($m, $env_cb->({ plack_session => "../wrong" })); 193 | 194 | isnt('../wrong' => $opts->{id}, '... regenerate session id'); 195 | 196 | ok(!$s->{'foo'}, '... no value stored for foo in session'); 197 | 198 | lives_ok { 199 | $s->{foo} = 'baz'; 200 | } '... set the value successfully'; 201 | 202 | is($s->{'foo'}, 'baz', '... got the foo value back successfully from session'); 203 | 204 | is_deeply( $s, { foo => 'baz' }, '... got the session dump we expected'); 205 | 206 | $response_test->( $res, $opts->{id} ); 207 | } 208 | } 209 | 210 | 1; 211 | -------------------------------------------------------------------------------- /t/tmp/.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store --------------------------------------------------------------------------------