0.0.0.0:80 erinnemori-2 / master logic / logic.factor
master

Tree @master (Download .tar.gz)

logic.factor @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
! Copyright (C) 2025 Serre
! See https://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators csv
http http.server io.encodings.utf8 io.files
io.sockets io.streams.string kernel math.parser monadics
namespaces present sequences unicode xml.syntax
   erinnemori-2.posts
   erinnemori-2.users 
   erinnemori-2.utils
   erinnemori-2.xml ;
IN: erinnemori-2.logic

CONSTANT: log-file "resource:www-data/mod/log.csv"
: >log ( resource action -- )
   request get by-user?
   remote-address get 4array [ present ] map
   log-file utf8 [ write-row ] with-file-appender ;

: new-user>req ( E-Error/User -- req )
   dup Left?
   [ "Creating User..." f rot value>> >m
     create-user-page f erinne-common ]
   [ value>> "new-user" >log 
     "User Created!" 
     <XML <meta http-equiv="refresh"
                          content="3;url=/" /> XML>
     f "New user created, returning to main page" >default f
     erinne-common
   ] if ;

: process-login ( -- req )
   params get [ "erinne-user" of ]
              [ "erinne-pass" of ] bi
   2dup and [ login ] [ 2drop f ] if
            [ "Logged in, returning to homepage" >default ] 
      [ f "Bad Username or Password, try again." >default ] if*
   [ "Logging in..."  
     "1;url=/" refresh-header f ] dip f
   erinne-common 
   swap [ put-cookie ] when* ;

: process-board ( path board -- xml-main xml-footer )
   swap [ empty? not ] 1guard
      [ first [ topic>thread ] [ new-reply-form ] 2bi ]
      [ [ board-topics topics>board ] keep
        new-topic-form ] 
   if* ;

: process-topic ( -- header )
   params get
   { [ "board" of ]
     [ "session" of string>number 
       active-users get-global at ]
     [  "topic" of ]
     [   "body" of ]
     [ "images" of ]
     [   "tags" of ]
     [  "topic" of ]
   } cleave "new-topic" >log
   <topic> "1;url=" prepend refresh-header ;

: process-reply ( -- header )
   params get
   { [ "topic" of ]
     [ "board" of ]
     [ "board" of ]
     [ "topic" of ]
     [ "board" of ]
     [ "topic" of ]
     [ "session" of string>number 
       active-users get-global at ]
     [  "title" of ]
     [   "body" of ]
     [ "images" of ]
     [   "tags" of ]
   } cleave <post> 
      first 3array [ write-row ] with-string-writer 
      but-last "new-reply" >log
   topic-link "1;url=" prepend refresh-header ;

: process-rsrc ( -- header )
   params get  {
     [ "topic" of ]
     [ "board" of ]
     [ "topic" of ]
     [ "board" of ]
      [ "link" of ]
      [ "desc" of ]
     [ "board" of ]
     [ "topic" of ]
      [ "link" of ]
   } cleave 3array [ write-row ] with-string-writer 
      but-last "resource-added" >log
   add-resource
   topic-link "1;url=" prepend refresh-header ;