server.ml (2793B)
1 (* TODO: Make this a whitelist based on the page / course lists *) 2 (* TODO: Favicon *) 3 4 let is_safe_path name = 5 String.length name > 0 6 && name <> "." && name <> ".." 7 && String.for_all 8 (fun c -> 9 (c >= 'a' && c <= 'z') 10 || (c >= 'A' && c <= 'Z') 11 || (c >= '0' && c <= '9') 12 || c = '-' || c = '_' || c = '.') 13 name 14 15 (* TODO: Ensure server responds correctly to invalid requests. *) 16 (* 17 Examples: Non-existent course 18 Examples: Non-existent page 19 Examples: Non-existent asset 20 Examples: Unknown path 21 *) 22 23 let my_error_template _error debug_info suggested_response = 24 let status = Dream.status suggested_response in 25 let code = Dream.status_to_int status 26 and reason = Dream.status_to_string status in 27 Dream.set_header suggested_response "Content-Type" Dream.text_html; 28 Dream.set_body suggested_response 29 ("<h1>" ^ string_of_int code ^ " - " ^ reason ^ "</h1>"); 30 Lwt.return suggested_response 31 32 let get_course_name request = Dream.param request "course_name" 33 let get_page_name request = Dream.param request "page_name" 34 35 (* TODO: When should trailing slash be in a url? *) 36 (* TODO: If sticking with course_name/ then course_name ^ "/" redirect *) 37 38 let is_valid_course name = 39 let pth = Shared.course_dir ^ name in 40 is_safe_path name && Shared.is_directory pth 41 42 let is_valid_page course_name page_name = 43 let pth = Shared.course_dir ^ course_name ^ "/" ^ page_name in 44 is_safe_path course_name && is_safe_path page_name && Shared.is_file pth 45 46 let routes = 47 [ 48 Dream.get "/course/:course_name/" (fun request -> 49 let name = get_course_name request in 50 if is_valid_course name then 51 Dream.html (Render.render_sidebar @@ Render.render_course_home name) 52 else Dream.empty `Not_Found); 53 Dream.get "/course/:course_name/page/:page_name" (fun request -> 54 let course_name = get_course_name request in 55 let page_name = get_page_name request in 56 if is_valid_course course_name then 57 if is_valid_page course_name page_name then 58 Dream.html @@ Render.render_sidebar 59 @@ Render.render_page course_name page_name 60 else Dream.empty `Not_Found 61 else Dream.empty `Not_Found); 62 Dream.get "/static/**" (Dream.static "./static"); 63 Dream.get "/" (fun request -> 64 Dream.html (Render.render_sidebar @@ Render.render_course_list ())); 65 Dream.get "/robots.txt" (Dream.from_filesystem "./static" "robots.txt"); 66 Dream.get "/course/:course_name/page/assets/**" (fun request -> 67 let name = get_course_name request in 68 if is_valid_course name then 69 Dream.static (Shared.course_dir ^ name ^ "/assets") request 70 else Dream.empty `Not_Found); 71 ] 72 73 let handler = Dream.error_template my_error_template