/* * * server for the module Card. * by MAgical Fred december, 98 * */ /****************************************************************************/ /* */ /* definition of data structures */ /* */ /****************************************************************************/ struct Favorite = [ authorFAV : S, /* author of the site */ sitenameFAV : S, /* sitename of the site */ emailFAV : S, /* email of the author */ messageFAV : S, /* message du site */ ipFAV : S, /* derniere ip connue du site */ lastFAV : S, /* derniere connection */ idnumFAV : I, /* idnum */ bitmapFAV : S, /* bitmap filename */ signatureFAV : S, /* signature of the bitmap */ flagFAV : I /* flag of the site */ ] mkFAV ;; fun newFavorite (author, sitename, email, message, ip, last, idnum, bitmap, signature, flag)= mkFAV [author sitename email message ip last idnum bitmap signature flag];; /****************************************************************************/ /* */ /* definitions of variables */ /* */ /****************************************************************************/ var printMessages = 0;; typeof listFAV = [ Favorite r1 ] ;; typeof emailS = S ;; typeof authorS = S ;; typeof annuaireS = S ;; typeof messageS = S ;; typeof bitmapS = S ;; typeof passS = S ;; var registerI = 0 ;; typeof MyTimer = Timer ;; var checkLastTime = 3600000;; /* var checkLastTime = 60000;; */ var lang1 = -1 ;; var lang2 = -1 ;; var lang3 = -1 ;; var catIdnum = 1 ;; typeof channelA = Chn ;; /* channel to the register site */ defcom Ccard = card S S S S S ;; defcom Cbitmap = bitmap S S ;; defcom CgoingDown = goingDown S S S ;; defcom CregisterOff = registerOff ;; defcom Cconnectip = checkconnect S ;; defcom CsetLangage = setLangage I I I ;; defcom CsetCategory = setCategory I ;; fun genldbitmap(name)= let _LDbitmap _channel _checkpack name -> u in if u != nil then u else _LDjpeg _channel _checkpack name;; fun findFavByNum(l,num)= if l == nil then nil else let l -> [ c next ] in if c.idnumFAV==num then c else findFavByNum next num;; fun WrongPassword()= _DMSevent this nil "registration ko" nil nil; _fooS "Invalid Password"; if printMessages then _DLGMessageBox _channel nil "Invalid Password" strcatn "Your password is not allowed by the directory. A site bearing the same name, author and email ":: "has already been registered - Please check your email or ask cryo-networks in order to know your password.":: nil 0 else nil;; fun nameRefused (title, mess)= _DMSevent this nil "registration ko" nil nil; _fooS strcatn "nameRefused\n "::title::" "::mess::nil; if printMessages then _DLGMessageBox _channel nil title mess 0 else nil;; /****************************************************************************/ /* */ /* parse a dmi file to get the informations about the module */ /* */ /****************************************************************************/ fun PARSEdmi(l)= if l == nil then 0 else let l -> [ line next ] in let line -> [ kword [ arg _ ]] in ( if !strcmp kword "author" then set authorS = arg else if !strcmp kword "msg" then set messageS = arg else if !strcmp kword "email" then set emailS = arg else if !strcmp kword "directory" then set annuaireS = arg else if !strcmp kword "image" then set bitmapS = arg else if !strcmp kword "password" then set passS = arg else if !strcmp kword "reg" then (set registerI = atoi arg;nil) else if !strcmp kword "catidnum" then (set catIdnum = atoi arg;nil) else if !strcmp kword "langage" then let line -> [ _ [ l1 [ l2 [ l3 _ ]]]] in ( set lang1 = if l1 == nil then -1 else atoi l1; set lang2 = if l2 == nil then -1 else atoi l2; set lang3 = if l3 == nil then -1 else atoi l3; nil ) else if !strcmp kword "favorite" then ( _fooS strcat "FAV FOUND " arg; let strextr arg -> [[ author [ sitename [ email _ ]]] _] in set listFAV = [ (newFavorite author sitename email nil nil nil nil nil nil nil) listFAV ]; nil ) else nil; PARSEdmi next ) ;; /****************************************************************************/ /* */ /* Handle action from others modules */ /* */ /****************************************************************************/ fun activate(from,cli,action,param,rep)= if !strcmp action "destroy" then _DMSdelClientDMI this cli else _DMScreateClientDMI this cli strbuild (authorS::DMSname::emailS::nil)::nil ;; /****************************************************************************/ /* */ /* fun closeSite [] -> I */ /* */ /* module callback of site's stop. The module registers the site */ /* as inactive on the directory site */ /* */ /****************************************************************************/ fun closeSite()= set channelA = _openchannel annuaireS nil _envchannel _channel; _fooS strcat "closeSite : Opening channel to ANNUAIRE " annuaireS ; if channelA != nil then _fooS "CHANNEL OPEN" else _fooS "CHANNEL NOT OPEN"; _on channelA CgoingDown [authorS DMSname emailS];; /****************************************************************************/ /* */ /* callback du timer */ /* */ /****************************************************************************/ fun checkLast(a,b)= set channelA = _openchannel annuaireS "_load \"Dms/CommTools/Card/cardcli.pkg\"\ncheckLast" _envchannel _channel; _fooS strcat "checkLast : Opening channel to ANNUAIRE " annuaireS; if channelA != nil then _fooS "CHANNEL OPEN" else _fooS "CHANNEL NOT OPEN" ;; /* if registerI == 0 then { _fooS "NO REGISTER"; _on channelA CregisterOff []; } else { _on channelA Ccard [ authorS DMSname emailS messageS passS]; _fooS strbuild ("REGISTER"::authorS::DMSname::emailS::messageS::passS::"*"::nil)::nil; _on channelA Cconnectip [_hostIP]; };; */ /****************************************************************************/ /* */ /* IniDMI ( S filename ) -> I */ /* */ /* Init function of the directory module */ /* */ /****************************************************************************/ fun IniDMI(file)= _DMSregisterDMI this @activate nil nil @closeSite; PARSEdmi strextr _getpack _checkpack file; set printMessages = let _getress "logwin" -> str in (str==nil) || (!strcmp str "yes"); /* send registration of the site */ let 0 -> i in let nth_char annuaireS 0 -> c in ( while (c!=nil) && ( c != 0 ) && ( c != ': ) do ( set i = i + 1; set c = nth_char annuaireS i ); let substr annuaireS 0 i -> add in let _fooS add -> uuu in set annuaireS = strcat _gethostbyname add substr annuaireS i (strlen annuaireS) - i ); set channelA = _openchannel annuaireS "_load \"Dms/CommTools/Card/cardcli.pkg\"\nletsGo" _envchannel _channel; _fooS strcat "IniDMI : Opening channel to ANNUAIRE " annuaireS; if channelA != nil then _fooS "CHANNEL OPEN" else _fooS "CHANNEL NOT OPEN"; set MyTimer = _rfltimer _starttimer _channel checkLastTime @checkLast 0 ; 0 ;; /****************************************************************************/ /* */ /* the client ask how many favorites */ /* */ /****************************************************************************/ defcom CsendCount = sendCount I ;; fun __askCount()= _DMSsend this DMSsender CsendCount [ if listFAV == nil then 0 else sizelist listFAV ] ;; /****************************************************************************/ /* */ /* the client ask some favorites */ /* */ /****************************************************************************/ defcom CsendCard = sendCard S S S S S I S S ;; fun __askCard(i)= let nth_list listFAV i -> c in _DMSsend this DMSsender CsendCard [ c.authorFAV c.sitenameFAV c.emailFAV c.messageFAV c.ipFAV c.idnumFAV c.bitmapFAV c.signatureFAV ] ;; /****************************************************************************/ /* */ /* the client ask a favorite's bitmap */ /* */ /****************************************************************************/ defcom CsendBitmap = sendBitmap S I S I ;; defcom CendBitmap = endBitmap S I ;; fun __askBitmap (name, idnum, pos)= let findFavByNum listFAV idnum -> f in if !strcmp f.bitmapFAV name then let _FILEOpen _channel _checkpack name -> f in let _FILESize f -> flen in ( if flen >= pos then ( _FILESeek f pos 0 ; _on _channel CsendBitmap [ name idnum _FILERead f 1000 pos + 1000 ] ) else _on _channel CendBitmap [ name idnum ] ; _FILEClose f ) else _closechannel ;;