From 7cd208912f5e446fe86393d52f541dc40a16451f Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 10 Oct 2013 11:37:48 -0600 Subject: [PATCH] initial dynamic server --- .../meta/pkg-index/official/dynamic.rkt | 255 ++++++++++++++++++ .../meta/pkg-index/official/jsonp.rkt | 52 ++++ .../meta/pkg-index/official/static/index.html | 16 +- .../meta/pkg-index/official/static/index.js | 142 +++++++++- .../meta/pkg-index/official/static/style.css | 5 + 5 files changed, 457 insertions(+), 13 deletions(-) create mode 100644 pkgs/plt-services/meta/pkg-index/official/dynamic.rkt create mode 100644 pkgs/plt-services/meta/pkg-index/official/jsonp.rkt diff --git a/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt b/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt new file mode 100644 index 0000000000..35087f9c40 --- /dev/null +++ b/pkgs/plt-services/meta/pkg-index/official/dynamic.rkt @@ -0,0 +1,255 @@ +#lang racket/base +(require web-server/http + "common.rkt" + "jsonp.rkt" + web-server/servlet-env + racket/file + xml + racket/function + racket/runtime-path + web-server/dispatch + pkg/util + (prefix-in pkg: pkg/lib) + racket/match + racket/package + racket/system + racket/date + racket/string + web-server/servlet + web-server/formlets + racket/bool + racket/list + net/sendmail + meta/pkg-index/basic/main + web-server/http/id-cookie + file/sha1 + (prefix-in bcrypt- bcrypt) + version/utils) + +(define (package-info pkg-name #:version [version #f]) + (define no-version (hash-set (file->value (build-path pkgs-path pkg-name)) 'name pkg-name)) + (cond + [(and version + (hash-ref no-version 'versions #f) + (hash-ref (hash-ref no-version 'versions) version #f)) + => + (λ (version-ht) + (hash-merge version-ht no-version))] + [else + no-version])) + +(define (package-info-set! pkg-name i) + (write-to-file i (build-path pkgs-path pkg-name) + #:exists 'replace)) + +(define (package-exists? pkg-name) + (file-exists? (build-path pkgs-path pkg-name))) + +(define (hash-merge from to) + (for/fold ([to to]) + ([(k v) (in-hash from)]) + (hash-set to k v))) + +(define (hash-deep-merge ht more-ht) + (for/fold ([ht ht]) + ([(k new-v) (in-hash more-ht)]) + (hash-update ht k + (λ (old-v) + (cond + [(not old-v) + new-v] + [(hash? old-v) + (hash-deep-merge old-v new-v)] + [else + new-v])) + #f))) + +(define (curation-administrator? u) + (member u '("jay.mccarthy@gmail.com" "mflatt@cs.utah.edu"))) + +(define (api/upload req) + (define req-data (read (open-input-bytes (or (request-post-data/raw req) #"")))) + (match-define (list email given-password pis) req-data) + (define password-path (build-path users.new-path email)) + (define expected-password (file->bytes password-path)) + (cond + [(not (and (bcrypt-check expected-password given-password) + (curation-administrator? email))) + (response/sexpr #f)] + [else + (for ([(p more-pi) (in-hash pis)]) + (define pi (if (package-exists? p) + (package-info p) + #hash())) + (define new-pi (hash-deep-merge pi more-pi)) + (define updated-pi (let ([now (current-seconds)]) + (for/fold ([pi new-pi]) ([k (in-list '(last-edit last-checked last-updated))]) + (hash-set pi k now)))) + (package-info-set! p updated-pi) + (signal-update! #t p)) + (response/sexpr #t)])) + +(define (signal-update! force? pkg) + ;; XXX + (void)) + +(define (redirect-to-static req) + (redirect-to + (url->string + (struct-copy url (request-uri req) + [scheme "http"] + ;; XXX change these to the real static site + [host "localhost"] + [port 8001])))) + +(define-syntax-rule (define-jsonp/auth (f . pat) . body) + (define-jsonp + (f + ['email email] + ['passwd passwd] + . pat) + (ensure-authenticate email passwd (λ () . body)))) + +(define (salty str) + (sha1 (open-input-string str))) + +(define current-user (make-parameter #f)) +(define (ensure-authenticate email passwd body-fun) + (define passwd-path (build-path users.new-path email)) + (define old-passwd-path (build-path users-path email)) + + (define (authenticated!) + (parameterize ([current-user email]) + (body-fun))) + + (cond + [(and (not (file-exists? passwd-path)) + (file-exists? old-passwd-path)) + (cond + [(not (bytes=? (file->bytes old-passwd-path) + (string->bytes/utf-8 (salty passwd)))) + "failed"] + [else + (display-to-file (bcrypt-encode (string->bytes/utf-8 passwd)) + passwd-path) + (delete-file old-passwd-path) + (authenticated!)])] + [(not (file-exists? passwd-path)) + "new-user"] + [(not (bcrypt-check (file->bytes passwd-path) + (string->bytes/utf-8 passwd))) + "failed"] + [else + (authenticated!)])) + +(define email-codes (make-hash)) +(define-jsonp + (jsonp/authenticate + ['email email] + ['passwd passwd] + ['code email-code]) + (match (ensure-authenticate email passwd (λ () #t)) + ["failed" #f] + ["new-user" + (define passwd-path (build-path users.new-path email)) + + (cond + [(and (not (string=? "" email-code)) + (hash-ref email-codes email #f)) + => (λ (correct-email-code) + (cond + [(equal? correct-email-code email-code) + (when (not (file-exists? passwd-path)) + (display-to-file (bcrypt-encode (string->bytes/utf-8 passwd)) + passwd-path)) + + (hash-remove! email-codes email) + + #t] + [else + "wrong-code"]))] + [else + (define correct-email-code + (number->string (random (expt 10 8)))) + + (hash-set! email-codes email correct-email-code) + + (send-mail-message + "pkg@racket-lang.org" + "Account confirmation for Racket PNR" + (list email) + empty empty + (list "Someone tried to register your email address for an account on the Racket Package Catalog." + "If you want to proceed, use this email code:" + "" + correct-email-code + "" + "This code will expire, so if it is not available, you'll have to try to register again.")) + + "emailed"])] + [#t + (hasheq 'curation (curation-administrator? email))])) + +;; XXX +(define-jsonp/auth + (jsonp/package/modify) + #f) + +;; XXX +(define-jsonp/auth + (jsonp/package/version/add) + #f) + +;; XXX +(define-jsonp/auth + (jsonp/package/version/del) + #f) + +;; XXX +(define-jsonp/auth + (jsonp/package/tag/add) + #f) + +;; XXX +(define-jsonp/auth + (jsonp/package/tag/del) + #f) + +;; XXX +(define-jsonp/auth + (jsonp/package/curate) + #f) + +;; XXX +(define-jsonp/auth + (jsonp/update) + #f) + +(define-values (main-dispatch main-url) + (dispatch-rules + [("jsonp" "authenticate") jsonp/authenticate] + [("jsonp" "update") jsonp/update] + [("jsonp" "package" "modify") jsonp/package/modify] + [("jsonp" "package" "version" "add") jsonp/package/version/add] + [("jsonp" "package" "version" "del") jsonp/package/version/del] + [("jsonp" "package" "tag" "add") jsonp/package/tag/add] + [("jsonp" "package" "tag" "del") jsonp/package/tag/del] + [("jsonp" "package" "curate") jsonp/package/currate] + [("api" "upload") #:method "post" api/upload] + [else redirect-to-static])) + +(define (go port) + (printf "launching on port ~a\n" port) + (serve/servlet + main-dispatch + #:command-line? #t + #:listen-ip #f + #:ssl? #t + #:ssl-cert (build-path root "server-cert.pem") + #:ssl-key (build-path root "private-key.pem") + #:extra-files-paths empty + #:servlet-regexp #rx"" + #:port port)) + +(module+ main + (go 9004)) diff --git a/pkgs/plt-services/meta/pkg-index/official/jsonp.rkt b/pkgs/plt-services/meta/pkg-index/official/jsonp.rkt new file mode 100644 index 0000000000..eca6be5015 --- /dev/null +++ b/pkgs/plt-services/meta/pkg-index/official/jsonp.rkt @@ -0,0 +1,52 @@ +#lang racket/base +(require json + web-server/http + racket/match) + +(define (response/jsonp callback o) + (response/output + (λ (op) + (fprintf op "~a(" callback) + (write-json o op) + (fprintf op ");")) + #:mime-type #"application/javascript")) + +(define (request-jsonp-data req) + (for/fold ([ht (hasheq)]) + ([b (in-list (request-bindings/raw req))]) + (match b + [(binding:form id value) + (define p (map string->symbol (parse-jsonp-path (bytes->string/utf-8 id)))) + (hash*-set ht p + (bytes->string/utf-8 value))] + [_ ht]))) + +(define parse-jsonp-path + (match-lambda + [(regexp #rx"^([^[]+)\\[([^]]+)\\](.*)$" + (list _ fst snd rst)) + (list* fst (parse-jsonp-path (format "~a~a" snd rst)))] + [s + (list s)])) + +(define (hash*-set ht p v) + (match p + [(list k) + (hash-set ht k v)] + [(list-rest f r) + (hash-update ht f (λ (fht) (hash*-set fht r v)) (hasheq))])) + +(define (make-jsonp-responder f) + (λ (req) + (define og (request-jsonp-data req)) + (response/jsonp + (hash-ref og 'callback) + (f (hash-remove (hash-remove og 'callback) '_))))) + +(define-syntax-rule (define-jsonp (f . pat) . body) + (define f + (make-jsonp-responder + (match-lambda [(hash-table . pat) . body])))) + +(provide define-jsonp + make-jsonp-responder) diff --git a/pkgs/plt-services/meta/pkg-index/official/static/index.html b/pkgs/plt-services/meta/pkg-index/official/static/index.html index e54604c132..38ed447f2b 100644 --- a/pkgs/plt-services/meta/pkg-index/official/static/index.html +++ b/pkgs/plt-services/meta/pkg-index/official/static/index.html @@ -12,11 +12,23 @@

+
+ + + + +
Email Address:
Password:
+ +

If you enter an unclaimed email address, then an account will + be created.

+

Passwords are stored in the delicious bcrypt format, but + transfered as plain-text over the HTTPS connection.

+
+
diff --git a/pkgs/plt-services/meta/pkg-index/official/static/index.js b/pkgs/plt-services/meta/pkg-index/official/static/index.js index 5e3b347fa0..035e6fd491 100644 --- a/pkgs/plt-services/meta/pkg-index/official/static/index.js +++ b/pkgs/plt-services/meta/pkg-index/official/static/index.js @@ -1,10 +1,9 @@ -// xxx display curation if allowed -- http://localhost:8001/#(!:conflicts:)(ring:2) -// xxx logout -// xxx what user am i -// xxx upload package -// xxx bulk upload api -// xxx update -// xxx add a tag api +// xxx change these to the real thing +var dynamic_host = "localhost"; +var dynamic_port = 9004; + +function dynamic_url ( u ) { + return "https://" + dynamic_host + ":" + dynamic_port + u + "?callback=?"; } $( document ).ready(function() { $("#package_info").dialog({ @@ -39,8 +38,10 @@ $( document ).ready(function() { $( "#pi_last_checked" ).text( format_time(pkgi['last-checked']) ); $( "#pi_last_edit" ).text( format_time(pkgi['last-edit']) ); $( "#pi_description" ).text( pkgi['description'] ); + // xxx show delete tag buttons $( "#pi_tags" ).html("").append( $.map( pkgi['tags'], function ( tag, i ) { return [tag, " "]; } ) ) + // xxx show add and delete buttons $( "#pi_versions" ).html("").append( $.map( pkgi['versions'], function ( vo, v ) { return [ $('').append( $('', + // xxx show curate links { class: ((now - (60*60*24*2)) < value['last-updated'] ? "recent" : "old") }) .data( "obj", value) .append( @@ -210,4 +223,111 @@ $( document ).ready(function() { evaluate_search(); if ( target_pkg && resp[target_pkg] ) { - open_info ( resp[target_pkg] ) } }); }); + open_info ( resp[target_pkg] ) } }); + + $("#login").dialog({ + autoOpen: false, + minWidth: 600, + minHeight: 600, + position: { my: "center", at: "center", of: "#search_menu" }, + modal: true }); + + var saved_password = false; + function login_submit () { + $( "#login_error" ).html( "" ); + + var et = $( "#login_email_text" ); + var pt = $( "#login_passwd_text" ); + + var e = et.val(); + var p; + var c; + if ( saved_password ) { + p = saved_password; + c = pt.val(); } + else { + p = pt.val(); + c = ""; } + + $.getJSON( dynamic_url("/jsonp/authenticate"), + { email: e, passwd: p, code: c }, + function( resp ) { + if ( resp == "emailed" ) { + saved_password = p; + $( "#login_passwd_label" ).html( "Code:" ); + pt.val(""); + $( "#login_error" ).html( "Check your email for an email code." ); } + else if ( resp == "wrong-code" ) { + pt.val(""); + $( "#login_error" ).html( "That is the incorrect code." ); } + else if ( resp ) { + $( "#login_passwd_label" ).html( "Password:" ); + + et.val(""); + pt.val(""); + + localStorage['email'] = e; + localStorage['passwd'] = p; + + $( "#login" ).dialog( "close" ); + + initial_login(); } + else { + pt.val(""); + $( "#login_error" ).html( "Incorrect password, please retry" ); }; } ); } + $( "#login_passwd_text" ).keypress( function (e) { + if (e.which == 13) { login_submit (); } } ); + $( "#login_button" ).click( function (e) { login_submit (); } ); + + function menu_logout () { + $("#logout").html( $('', { text: "login", + href: "javascript:void(0)", + click: function () { + $( "#login" ).dialog( "open" ); } } ) ); } + function menu_loggedin ( curate_p ) { + // xxx enable curate links + $("#logout").html("") + .append( localStorage['email'], + ( curate_p ? [ " (", $('', { text: "curator", + href: "javascript:void(0)", + click: function () { + clear_terms(); + search_terms[ "!:conflicts:" ] = true; + search_terms[ "ring:2" ] = true; + evaluate_search(); } } ), + ")" ] : ""), + " | ", + $('', { text: "upload", + href: "javascript:void(0)", + click: function () { + console.log("XXX upload"); } } ), + " | ", + $('', { text: "update", + href: "javascript:void(0)", + click: function () { + console.log("XXX update"); } } ), + " | ", + $('', { text: "logout", + href: "javascript:void(0)", + click: function () { + localStorage['email'] = ""; + localStorage['passwd'] = ""; + + menu_logout (); } } ) ); } + + function initial_login () { + $.getJSON( dynamic_url("/jsonp/authenticate"), + { email: localStorage['email'], passwd: localStorage['passwd'], code: "" }, + function( resp ) { + if ( $.isPlainObject(resp) ) { + menu_loggedin( resp['curation'] ); } + else { + menu_logout(); + console.log( "login failed" ); } } ); } + + + if ( localStorage['email'] && localStorage['passwd'] ) { + initial_login(); + } else { + menu_logout (); + } }); diff --git a/pkgs/plt-services/meta/pkg-index/official/static/style.css b/pkgs/plt-services/meta/pkg-index/official/static/style.css index 9132f76d85..905382c0a6 100644 --- a/pkgs/plt-services/meta/pkg-index/official/static/style.css +++ b/pkgs/plt-services/meta/pkg-index/official/static/style.css @@ -145,3 +145,8 @@ a.inactive { } a.possible { } + +#login table tr:nth-child(3) td { + text-align: center; + color: red; +}
Package Name:
').html(v), $('').html(vo['source']) ), @@ -51,10 +52,10 @@ $( document ).ready(function() { function submit_add_tag () { var it = $( "#pi_add_tag_text" ); - // + // XXX really add tag active_info['tags'].push( it.val() ); update_info( active_info ); - // + it.val("");} $( "#pi_add_tag_text" ).keypress( function (e) { if (e.which == 13) { submit_add_tag (); } } ); @@ -62,6 +63,11 @@ $( document ).ready(function() { var search_terms = { }; + function clear_terms () { + $.each(search_terms, + function ( term, termv ) { + delete search_terms[term];} ); } + function parse_hash ( h ) { while ( h != "" ) { if ( h.charAt(0) == "(" ) { @@ -143,7 +149,11 @@ $( document ).ready(function() { $.each(vterms, function ( term, termv ) { if ( term.substring(0,7) != "author:") { shown_terms[term]++; } }); } else { - $(dom).hide(); } }); + $(dom).hide(); + + $.each(vterms, function ( term, termv ) { + if ( term.substring(0,7) != "author:") { + if ( ! shown_terms[term]) { shown_terms[term] = 0; } } });} }); $.each(search_terms, function ( term, termv ) { @@ -165,6 +175,8 @@ $( document ).ready(function() { else { change_hash( window.location.hash + "(" + "!" + term + ")" ); return removefilterlink ( term, "!" + term, "inactive" ); } } + else if ( shown_terms[term] == 0 ) { + return [ term, " " ]; } else { return addfilterlink ( term, term, "possible" ); } } ) ); @@ -193,6 +205,7 @@ $( document ).ready(function() { var value = resp[name]; $('