Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Tripcode decoder?

Name: Anonymous 2007-12-03 19:48

is there anyway to convert a tripcode into the password for that tripcode, im using tripsage and I see that you can put in a word you want to see in a trip code and it produces results of passwords that would produce a tripcode with those letters in it, so if we were to take a complete tripcode someone has and enter it into that field, in theory it should eventually produce the 1 password that produces that tripcode, however i have a core 2 duo e6600 which can run 170,000 crypts per second but with over 10^80 possible combinations(numbers + letters + capital letters + symbols, and 10 characters in a tripcode) it would take litteraly much more than trillions of years to run through every combination. Any other suggestions?

Name: !WoqhnLcR3E 2009-04-02 3:59

wat

Name: Anonymous 2009-04-02 7:10

>>600-601
Worthless dolt.

Name: Anonymous 2009-04-02 7:12

Guys, guys... hey guys....
In a mere 397 more posts this miserable thread will be gone forever.

Name: Anonymous 2009-04-02 11:56

>>603
nyoro~n

Name: Anonymous 2009-04-07 15:54

f uuuuuuuuuuuuuuuuuuuuu

Name: Anonymous 2009-04-07 16:12

>>603
The twenty or so posts that are actually about tripcodes are pretty interesting, though.
This thread had potential. It's sad people must step on every dream.

Name: Anonymous 2009-04-07 16:15

{-# INCLUDE <crypt.h> #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Main (main) where

import Char (chr, ord)
import Foreign.C
import System (getArgs, exitFailure)
import Random
import Text.Regex.Posix
import System.IO.Unsafe (unsafePerformIO)

-- We'll need crypt(3)
foreign import ccall "crypt" crypt :: CString -> CString -> CString

-- Generate the salt
salt :: String -> String
salt t  =
    map f . take 2 . tail $ t ++ "H.."
    where
      f c
        | c `notElem` ['.'..'z'] = '.'
        | c `elem` [':'..'@'] = chr $ ord c + 7
        | c `elem` ['['..'`'] = chr $ ord c + 6
        | otherwise = c

-- The actual tripcode
tripcode :: String -> String
tripcode tr = unsafePerformIO $ do
    trip <- newCString tr
    salt <- newCString $ salt tr
    trip <- peekCString $ crypt trip salt
    return . drop (length trip - 10) $ trip

makeString :: (Char,Char) -> IO String
makeString (a,b) = mapM randomRIO $ replicate 8 (a,b)

showTrip :: IO (Bool,(String,String)) -> IO ()
showTrip t = do
    (b,(s,t)) <- t
    if b then putStrLn $ s ++ " -> " ++ t else return ()

tripTuple :: IO String -> IO (String, String)
tripTuple s = do
    s <- s
    return (s,tripcode s)

matchTrip :: String -> IO (String,String) -> IO (Bool,(String,String))
matchTrip r t = do
    (s,t) <- t
    return (t =~ r,(s,t))

main :: IO ()
main = do
    args <- getArgs
    f args
    where
      f [] = do
          mapM_ (showTrip . matchTrip "." . tripTuple . makeString) $ repeat (' ','~')
      f args = do
          mapM_ (showTrip . (matchTrip $ head args) . tripTuple . makeString) $ repeat (' ','~')

Name: Anonymous 2009-04-07 18:47

>>607
The new version Xarn posted earlier today is better: http://cairnarvon.rotahall.org/2009/04/07/literate-tripcrackers/

Name: Anonymous 2009-04-07 18:53

>>608
better, but still slow as fuck.

Name: Anonymous 2009-04-07 18:56

Have your read your Xarn's blog today?

Name: Anonymous 2009-04-07 18:56

>>609
There are a million fast tripcrackers in C out there already. Once you get past bitslicing, there are no real challenges left in C and the rest is just busywork.

Haskell, now there's a real challenge.

Name: Anonymous 2009-04-07 18:58

>>611
so get to bitslicing in haskell already instead of just calling c code from haskell.

Name: Anonymous 2009-04-07 19:37

>>612
What have you done recently, dipshit? Or are you just here to leech off other people's work so you can impress your middle school friends with your omgawsum novelty tripcode?

Name: Anonymous 2009-04-07 19:40

>>613
I read SICP.

Name: Anonymous 2009-04-07 19:42

>>613

primes = 2 : 3 : 5 : 7 : [k + r | k <- [0, 30..], r <- [11, 13, 17, 19, 23, 29, 31, 37], primeTest (k + r)]
    where primeTest n = all ((0 /=) . mod n) . takeWhile ((n >=) . join (*)) $ drop 3 primes

bitCount 0 = 0
bitCount n = uncurry (+) . (first bitCount) $ divMod n 2

swing n | n < 33 = genericIndex smallOddSwing n
        | True   = product pList
    where smallOddSwing = [1, 1, 1, 3, 3, 15, 5, 35, 35, 315, 63, 693, 231, 3003, 429, 6435, 6435, 109395, 12155, 230945, 46189, 969969, 88179, 2028117, 676039, 16900975, 1300075, 35102025, 5014575, 145422675, 9694845, 300540195, 300540195]
          pListA q p prime = let x = div q prime in case x of
                                                         0 -> case p of
                                                                   1 -> []
                                                                   _ -> [p]
                                                         _ -> pListA x (p * prime ^ (mod x 2)) prime
          pListB = (filter ((1==) . flip mod 2 . div n) . takeWhile (<= div n 3) $ dropWhile ((<= n) . (^2)) primes)
          pListC = takeWhile (<= n) $ dropWhile (<= div n 2) primes
          pList = (concatMap (pListA n 1) . takeWhile ((n >=) . (^2)) $ tail primes) ++ pListB ++ pListC

recFactorial n | n < 2 = 1
               | True  = (recFactorial $ div n 2) ^ 2 * swing n

factorial n | n < 20 = product [2..n]
            | True   = recFactorial n * 2 ^ (n - bitCount n)

Name: Anonymous 2009-04-07 20:10

>>615
EXPERT COPY/PASTER

The fact that you think that's an example of decently-fast Haskell code demonstrates that you don't even know how it works.

Name: Anonymous 2009-04-07 20:12

>>616
You've never used Haskell in your life, you lying fucker.

Name: Anonymous 2009-04-07 20:24

>>616
i wrote that code.
you can't even copy and paste.

Name: Anonymous 2009-04-07 20:41

I rewrote the LINUX kernel in Scheme

Name: Anonymous 2009-04-07 20:51

>>619
Hey, me too. Small world eh?

Name: Anonymous 2009-04-07 21:20

>>619-620
source or it didn't happen.

Name: Anonymous 2009-04-07 21:36

>>621
(exec 'Linux')

Name: Anonymous 2009-04-07 21:40

>>622
> (exec 'Linux')

Error: unexpected right parenthesis
       (&i/o-port-error (port . #{Input-port #{Input-channel "standard input"}}))
       (&i/o-read-error (port . #{Input-port #{Input-channel "standard input"}}))

Name: Anonymous 2009-04-07 21:58

>>623
Hey, I use Scheme48 too.

Name: Anonymous 2009-04-12 3:13

can i get a trip code with 'thug aim' in it plox?

Name: Anonymous 2009-04-12 3:21

>>625
What the hell is this shit?

Name: Anonymous 2009-04-12 3:40

Name: !Pm7Ji3D6aI 2009-04-16 20:56

what

Name: !thUGAiMb9Y 2009-04-16 21:57

>>625
here you go: #cv0.4fmz;

Name: Anonymous 2009-04-16 22:27

>>629
IHBT

Name: wtf !niQsDAYhx. 2009-04-17 15:49

whatisthisidonteven

Name: The wise !b/.dFTOPGE 2009-04-17 17:15

Trippy

Name: Anonymous 2009-04-23 1:56

USING: alien generalizations macros openssl random regexp ;

: tripchar ( -- char ) " !#$%()*+-./0123456789:;=?ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~" random ;
: saltchar ( -- char ) "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" random ;
: randomkey ( -- key ) tripchar saltchar saltchar tripchar tripchar tripchar tripchar tripchar 8 narray >string ;
: crypt ( key salt -- hash ) "char*" "libcrypto" "DES_crypt" { "char*" "char*" } alien-invoke ;
: dotrip ( key -- hash ) [ 1 3 ] keep subseq crypt 3 tail ;
: randomtrip ( -- key hash ) randomkey [ dotrip ] keep ;
: checktrip ( key hash regexp -- key hash bool ) [ over ] dip re-contains? ;
: showtrip ( key hash -- ) write " = " write print flush ;
: findtrips ( regexp -- regexp ) [ [ randomtrip ] keep checktrip [ showtrip ] [ 2drop ] if t ] loop ;

factor makes you write better code.

Name: lol !xlyK1nogKs 2009-04-30 12:12

yeh!!!

Name: wat !Green6.LdE 2009-05-03 21:11

lol

Name: wat !PCrd6Ll2sA 2009-05-03 21:12

also

Name: Anonymous 2009-05-05 13:18

>>633
expert forth programmer.

Name: Anonymous 2009-05-05 13:21

>>637
EXPERT NECRO THREAD BUMPER

Name: Anonymous 2009-05-05 13:27

>>638
If this thread doesn't get bumped at least once a month, Xarn kills a baby seal

Name: Anonymous 2009-05-05 13:30

>>639
Xarn kills a baby seal
LIES! Xarn is too much of a tree hugging liberal to do such a thing!

Newer Posts