/* * * server for the module Card. * by MAgical Fred december, 98 * * Version DemoCryonics, March 99 */ /****************************************************************************/ /* */ /* 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 */ ] mkFAV ;; /****************************************************************************/ /* */ /* definitions of variables */ /* */ /****************************************************************************/ 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 ;; 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 CregisterDemo = demo ;; 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()= _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 ;; /****************************************************************************/ /* */ /* 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 "favorite" then ( _fooS strcat "FAV FOUND " arg ; let strextr arg -> [[ author [ sitename [ email _ ]]] _] in set listFAV = [ mkFAV [ author sitename email 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; 0 ) else ( _DMScreateClientDMI this cli strbuild (authorS::DMSname::emailS::nil)::nil ; 0 );; /****************************************************************************/ /* */ /* 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 ; _on channelA CgoingDown [ authorS DMSname emailS ] ; _killchannel channelA ; 0 ;; /****************************************************************************/ /* */ /* callback du timer */ /* */ /****************************************************************************/ fun checkLast(a,b)= set channelA = _openchannel annuaireS "_load \"dms/commtools/card/WizardFlash/cardcli.pkg\"" _envchannel _channel ; _on channelA CregisterDemo [] ; if registerI == 1 then _on channelA CregisterOff [] else _on channelA Ccard [ authorS DMSname emailS messageS passS] ; if registerI == 1 then _on channelA Cconnectip [ _hostIP ] else nil ; 0 ;; /****************************************************************************/ /* */ /* IniDMI ( S filename ) -> I */ /* */ /* Init function of the directory module */ /* */ /****************************************************************************/ fun IniDMI(file)=_DMSregisterDMI this @activate nil nil @closeSite; PARSEdmi strextr _getpack _checkpack file ; 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/WizardFlash/cardcli.pkg\"" _envchannel _channel ; _fooS strcat "Opening channel to ANNUAIRE " annuaireS ; if channelA != nil then _fooS "CHANNEL OPENED" else _fooS "CHANNEL NOT OPENED" ; /* send registration of the site */ _on channelA CregisterDemo [] ; if registerI == 0 then _on channelA CregisterOff [] else _on channelA Ccard [ authorS DMSname emailS messageS passS] ; if registerI == 1 then _on channelA Cconnectip [ _hostIP ] else nil ; if registerI == 0 then _fooS "NO REGISTER" else _fooS strbuild ("REGISTER"::authorS::DMSname::emailS::messageS::passS::"*"::nil)::nil ; /* send signature of the bitmap used */ let genldbitmap bitmapS -> b in let _GETbitmapSize b -> [ w h ] in if (b != nil) && (w==128) && (h==128) then ( let _getlongname _getpack _checkpack bitmapS bitmapS "#" -> signature in _on channelA Cbitmap [bitmapS signature ] ; _DSbitmap b ) else 0 ; set MyTimer = _rfltimer _starttimer _channel 3600000 @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 ;;