initial dynamic server
This commit is contained in:
Jay McCarthy
parent
476ab123f2
commit
7cd208912f
255
pkgs/plt-services/meta/pkg-index/official/dynamic.rkt
Normal file
255
pkgs/plt-services/meta/pkg-index/official/dynamic.rkt
Normal file
|
|
@ -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))
|
||||
52
pkgs/plt-services/meta/pkg-index/official/jsonp.rkt
Normal file
52
pkgs/plt-services/meta/pkg-index/official/jsonp.rkt
Normal file
|
|
@ -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)
|
||||
|
|
@ -12,11 +12,23 @@
|
|||
<body>
|
||||
<div class="breadcrumb">
|
||||
<span><a href="/">Packages</a></span>
|
||||
|
||||
<span id="logout">jay.mccarthy@gmail.com | <a href="/upload">upload</a> | <a href="/update">update</a> | <a href="/account/logout">logout</a> </span>
|
||||
<span id="logout"></span>
|
||||
</div>
|
||||
<p id="search_menu"></p>
|
||||
|
||||
<div id="login" class="package">
|
||||
<table>
|
||||
<tr><td>Email Address:</td><td><input id="login_email_text" type="text"></td></tr>
|
||||
<tr><td id="login_passwd_label">Password:</td><td><input id="login_passwd_text" type="password"></td></tr>
|
||||
<tr><td colspan="2" id="login_error"></td></tr>
|
||||
</table>
|
||||
<button id="login_button">Log In</button>
|
||||
<p>If you enter an unclaimed email address, then an account will
|
||||
be created.</p>
|
||||
<p>Passwords are stored in the delicious bcrypt format, but
|
||||
transfered as plain-text over the HTTPS connection.</p>
|
||||
</div>
|
||||
|
||||
<div id="package_info" class="package">
|
||||
<table>
|
||||
<tr><td>Package Name:</td><td><span id="pi_name"></span></td></tr>
|
||||
|
|
|
|||
|
|
@ -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 [ $('<tr>').append( $('<td>').html(v),
|
||||
$('<td>').html(vo['source']) ),
|
||||
|
|
@ -51,10 +52,10 @@ $( document ).ready(function() {
|
|||
|
||||
function submit_add_tag () {
|
||||
var it = $( "#pi_add_tag_text" );
|
||||
// <xxx>
|
||||
// XXX really add tag
|
||||
active_info['tags'].push( it.val() );
|
||||
update_info( active_info );
|
||||
// </xxx>
|
||||
|
||||
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];
|
||||
|
||||
$('<tr>',
|
||||
// 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( $('<a>', { 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 ? [ " (", $('<a>', { text: "curator",
|
||||
href: "javascript:void(0)",
|
||||
click: function () {
|
||||
clear_terms();
|
||||
search_terms[ "!:conflicts:" ] = true;
|
||||
search_terms[ "ring:2" ] = true;
|
||||
evaluate_search(); } } ),
|
||||
")" ] : ""),
|
||||
" | ",
|
||||
$('<a>', { text: "upload",
|
||||
href: "javascript:void(0)",
|
||||
click: function () {
|
||||
console.log("XXX upload"); } } ),
|
||||
" | ",
|
||||
$('<a>', { text: "update",
|
||||
href: "javascript:void(0)",
|
||||
click: function () {
|
||||
console.log("XXX update"); } } ),
|
||||
" | ",
|
||||
$('<a>', { 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 ();
|
||||
} });
|
||||
|
|
|
|||
|
|
@ -145,3 +145,8 @@ a.inactive {
|
|||
}
|
||||
a.possible {
|
||||
}
|
||||
|
||||
#login table tr:nth-child(3) td {
|
||||
text-align: center;
|
||||
color: red;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user