Phsu-0.1.0.1: src/PassGen.hs
{-# LANGUAGE OverloadedStrings #-}
module PassGen (servePassGen) where
import BoilerplateDB (App)
import Control.Applicative (optional, (<$>))
import Control.Monad.Trans (MonadIO(..))
import Data.Char (toLower)
import Data.List.Utils (startswith)
import Data.Maybe (fromMaybe)
import Data.String.Conversions (cs)
import Happstack.Server
import System.IO.Temp
import System.Process
import Template(template, myPolicy)
import Text.Blaze.Html5 (Html, (!), toHtml, toValue)
import Text.Blaze.Html5.Attributes (action, name, size, type_, value)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
javaCode::String
javaCode = "import java.math.*;import java.util.Random;public class PassGen { static String convert(char A[],String hex) { String s=\"\"; BigInteger b=new BigInteger(hex,16); while(!b.equals(new BigInteger(\"0\"))) { s+=A[b.mod(BigInteger.valueOf(A.length)).intValue()]; b=b.divide(BigInteger.valueOf(A.length)); } return s; } static long rightRotate(long x,int l) { return (x>>l)^((x&((1l<<l)-1))<<(32-l)); } static String preprocess(String a) { String s=\"\"; for(char x=0;x<a.length();x++) { String tt=Integer.toString(a.charAt(x),2); while(tt.length()<7) tt='0'+tt; s+=tt; } String sp=Long.toBinaryString(s.length()); s+=\"1\"; while(s.length()%512!=512-sp.length()) s+=\"0\"; s+=sp; return s; } static String f(long l) { String s = Long.toString(l,16); while(s.length()<8) s=\"0\"+s; return s; } static String[] breakString(String s,int l) { String A[] = new String[1+(s.length()-1)/l]; for(int x=0;x<A.length;x++) { A[x]=s.substring(0,l); s=s.substring(l); } return A; } static String sha1(String s) { long h0=0x67452301l,h1=0xEFCDAB89l,h2=0x98BADCFEl,h3=0x10325476l,h4=0xC3D2E1F0l; s=preprocess(s); String chunks[]=breakString(s,512); for(int x=0;x<chunks.length;x++) { s=chunks[x]; String words[]=breakString(s,32); long w[]=new long[80]; for(int i=0;i<16;i++)w[i]=Long.parseLong(words[i],2); for(int i=16;i<80;i++) { w[i]=w[i-3]^w[i-8]^w[i-14]^w[i-16]; w[i]=rightRotate(w[i],31); } long a=h0,b=h1,c=h2,d=h3,e=h4,f,k; for(int i=0;i<80;i++) { if(i<20) { k = 0x5A827999l; f=(b&c)|((~b)&d); } else if(i<40) { f=b^c^d; k = 0x6ED9EBA1l; } else if(i<60) { f=(b&c)|(b&d)|(c&d); k = 0x8F1BBCDCl; } else { f=b^c^d; k = 0xCA62C1D6l; } long tmp=(((a<<5)^(a>>27))&4294967295l)+f+e+k+w[i]; e=d; d=c; c=(((b<<30)^(b>>2))&4294967295l); b=a; a=tmp&4294967295l; } h0=(h0+a)&4294967295l; h1=(h1+b)&4294967295l; h2=(h2+c)&4294967295l; h3=(h3+d)&4294967295l; h4=(h4+e)&4294967295l; } return f(h0)+f(h1)+f(h2)+f(h3)+f(h4); } static String sha2(String s) { long h[]={ 0x6a09e667l, 0xbb67ae85l, 0x3c6ef372l, 0xa54ff53al, 0x510e527fl, 0x9b05688cl, 0x1f83d9abl, 0x5be0cd19l }, k[]={ 0x428a2f98l, 0x71374491l, 0xb5c0fbcfl, 0xe9b5dba5l, 0x3956c25bl, 0x59f111f1l, 0x923f82a4l, 0xab1c5ed5l, 0xd807aa98l, 0x12835b01l, 0x243185bel, 0x550c7dc3l, 0x72be5d74l, 0x80deb1fel, 0x9bdc06a7l, 0xc19bf174l, 0xe49b69c1l, 0xefbe4786l, 0x0fc19dc6l, 0x240ca1ccl, 0x2de92c6fl, 0x4a7484aal, 0x5cb0a9dcl, 0x76f988dal, 0x983e5152l, 0xa831c66dl, 0xb00327c8l, 0xbf597fc7l, 0xc6e00bf3l, 0xd5a79147l, 0x06ca6351l, 0x14292967l, 0x27b70a85l, 0x2e1b2138l, 0x4d2c6dfcl, 0x53380d13l, 0x650a7354l, 0x766a0abbl, 0x81c2c92el, 0x92722c85l, 0xa2bfe8a1l, 0xa81a664bl, 0xc24b8b70l, 0xc76c51a3l, 0xd192e819l, 0xd6990624l, 0xf40e3585l, 0x106aa070l, 0x19a4c116l, 0x1e376c08l, 0x2748774cl, 0x34b0bcb5l, 0x391c0cb3l, 0x4ed8aa4al, 0x5b9cca4fl, 0x682e6ff3l, 0x748f82eel, 0x78a5636fl, 0x84c87814l, 0x8cc70208l, 0x90befffal, 0xa4506cebl, 0xbef9a3f7l, 0xc67178f2l }; s=preprocess(s); String chunks[]=breakString(s,512); for(int x=0;x<chunks.length;x++) { s=chunks[x]; String words[]=breakString(s,32); long w[]=new long[64]; for(int i=0;i<16;i++) w[i]=Long.parseLong(words[i],2); for(int i=16;i<64;i++) { long s0=rightRotate(w[i-15],7)^rightRotate(w[i-15],18)^(w[i-15]>>3), s1=rightRotate(w[i-2],17)^rightRotate(w[i-2],19)^(w[i-2]>>10); w[i]=(w[i-16]+s0+w[i-7]+s1)&4294967295l; } long a[]=new long[8]; System.arraycopy(h, 0, a, 0, 8); for(int i=0;i<64;i++) { long s0 = rightRotate(a[0],2)^rightRotate(a[0],13)^rightRotate(a[0],22), maj = (a[0]&a[1])^(a[0]&a[2])^(a[1]&a[2]), t2 = (s0+maj)&4294967295l, s1 = rightRotate(a[4],6)^rightRotate(a[4],11)^rightRotate(a[4],25), ch = (a[4]&a[5])^((~a[4])&a[6]), t1 = (a[7]+s1+ch+k[i]+w[i])&4294967295l; a[7]=a[6]; a[6]=a[5]; a[5]=a[4]; a[4]=(a[3]+t1)&4294967295l; a[3]=a[2]; a[2]=a[1]; a[1]=a[0]; a[0]=(t1+t2)&4294967295l; } for(int i=0;i<8;i++) h[i]=(h[i]+a[i])&4294967295l; } String ans=\"\"; for(int x=0;x<8;x++) ans+=f(h[x]); return ans; } static String entwine(String a,String b,java.util.Random r) { boolean b1=true, b2=true; String entwined=\"\"; int id1=0, id2=0; while(b1||b2) { if(r.nextDouble()<a.length()/(a.length()+b.length()+0.0)) entwined+=a.charAt(id1++); else entwined+=b.charAt(id2++); if(id1==a.length()){b1=false;id1=0;} if(id2==b.length()){b2=false;id2=0;} } return entwined; } static int toNum(String s,long l) { return (new BigInteger(PassGen.sha1(s),16)).divide(BigInteger.valueOf(l)).intValue(); } static String processWebsiteName(String Kw2) { Kw2=Kw2.toLowerCase(); if(Kw2.startsWith(\"http:\")||Kw2.startsWith(\"https:\")) while(Kw2.charAt(0)!=':'&&Kw2.charAt(0)!='/') Kw2=Kw2.substring(1); while(Kw2.charAt(0)==':'||Kw2.charAt(0)=='/') Kw2=Kw2.substring(1); Kw2=Kw2.split(\"/\")[0]; return Kw2; } static String generatePassword(String Kw1,String Kw2,int length,char A[]) { int seed=(int)((((length* 786431l+toNum(Kw2,596572387l)*1848l+toNum(Kw1,1645333507l)* 333667l)%3626149l)*2796203l)% 1645333507l); Random r=new java.util.Random(seed); String finalPwd=\"\"; Kw1=entwine(Kw1,Kw2,r); while(length>0) { String sha=PassGen.convert(A,PassGen.sha2(Kw1)); if(length>=sha.length()) { finalPwd+=sha; length-=sha.length(); } else { finalPwd+=PassGen.randomPermutation(sha, r).substring(0,length); length=0; } Kw1=randomPermutation(sha,r); } return finalPwd; } static String randomPermutation(String s,java.util.Random r) { String s1=\"\"; while(s.length()>0) { int x=r.nextInt(s.length()); s1+=s.charAt(x); s=s.substring(0,x)+s.substring(x+1); } return s1; } public static void main(String args[]) { char A[]=new char[64]; for(int x='0';x<='9';x++) A[x-'0']=(char)x; for(int x='A';x<='Z';x++) { A[x-'A'+10]=(char)x; A[x-'A'+36]=(char)(x+32); } A[62]='<'; A[63]='>'; if (args.length != 3) { System.err.println(\"Usage: COMMAND website password length\"); System.exit(1); } String site = PassGen.processWebsiteName(args[0]); int length = Integer.parseInt(args[2]); System.out.print(PassGen.generatePassword(args[1], site, length, A)); }}"
exec site pwd len dir =
let codeFile = dir ++ "/PassGen.java"
in do
writeFile codeFile javaCode
readProcess "javac" [codeFile] ""
pw <- readProcess "java" ["-cp", dir, "PassGen", site, pwd, len] ""
return pw
getPassword = do
pwd <- cs <$> lookText "password"
site <- (processSiteName . (map toLower) . cs) <$> lookText "site"
len <- cs <$> lookText "length"
liftIO . (withTempDirectory "/tmp/" "src_temp") $ exec site pwd len
processSiteSuffix :: String -> String
processSiteSuffix = (takeWhile ((/=) '/')) . (dropWhile ((flip elem) ":/"))
processSiteName:: String -> String
processSiteName site
| startswith "http:" site || startswith "https:" site = processSiteSuffix . (dropWhile ((/=) ':')) $ site
| otherwise = processSiteSuffix site
passwordJs :: Maybe String -> String
passwordJs Nothing = ""
passwordJs (Just p) = "showPassword('" ++ p ++ "')"
serve :: Maybe String -> App Response
serve p = do
site <- (processSiteName . (map toLower) . cs . (fromMaybe "")) <$> (optional $ lookText "site")
len <- (cs . (fromMaybe "14")) <$> (optional $ lookText "length")
ok . (template "Password generator") $ do
H.script ! A.type_ (toValue ("text/javascript"::String)) $ "function showPassword(x) { window.prompt(\"password\", x); }"
H.body ! A.onload (toValue $ passwordJs p) $ do
H.h1 . toHtml $ ("Password generator"::String)
H.form ! action "/password" ! A.method (toValue ("POST"::String)) $ do
H.table $ do
H.thead $ do
H.td ! A.colspan (toValue ("2"::String))
! A.style (toValue ("padding-left:80px"::String)) $ do
H.b $ toHtml ("Generate Password"::String)
H.tbody $ do
H.tr $ do
H.td $ H.label . toHtml $ ("Website"::String)
H.td $ H.input ! type_ "text" ! (name . toValue) ("site"::String) ! value (toValue site) ! size "120"
H.tr $ do
H.td $ H.label . toHtml $ ("Password"::String)
H.td $ H.input ! type_ "password" ! (name . toValue) ("password"::String) ! size "25"
H.tr $ do
H.td $ H.label . toHtml $ ("Length"::String)
H.td $ H.input ! type_ "text" ! (name . toValue) ("length"::String) ! value (toValue (len::String)) ! size "3"
H.tfoot $ do
H.td ! A.colspan (toValue ("2"::String)) $ do
H.button ! name "op" $ toHtml ("Generate Password"::String)
servePassGen :: App Response
servePassGen = do
m <- rqMethod <$> askRq
case m of
GET ->
serve Nothing
POST -> do
decodeBody myPolicy
p <- getPassword
serve $ Just p