Stimulus 10 On rempile !!!

On rempile !!!
Programmation GFA (9)


Les maîtres Jedi ne veillissent jamais. Tels Yoda et Yoghourt, votre serviteur n'a pas pris une ride, et en 10 années, a eu assez de temps pour avoir un nouveau sujet de programmation GFA.
Utiliser STinG et ainsi coder son ptit client tcp/ip en GFA, c'est possible. Zipper avec compression en GFA, c'est aussi possible, grâce à l'emploi de quelques librairies externes appelées LDG (au pays du plantage de zindoz, on appelle ça des DLL). Il existe un site dédié à ces librairies dynamiques GEM que vous pouvez exploiter sans vergogne. A noter que si vous voulez coder votre propre librairie (en C, de préférence), il faut prendre une version plus ancienne, l'archive récente étant un chouillat corrompue.
Le principe
Les fonctions TCP/IP ou de compression ne sont pas dans votre magnifique code GFA. Elles se trouvent ailleurs (comme la vérité). Pour appeler ces fonctions, on utilise une particularité du GFA qui fait sa puissance : se la couler douce et faire intervenir du code C ou assembleur. Explication :

$C+
zlib_r%=C:zlib_deflate_init%(L:zlib_stream%,L:zlib_level%)
$C-
zlib_deflate_init% est la fonction qu'on appelle. C'est en fait une adresse, donc un entier LONG.
Comme pour les fonctions BIOS, XBIOS, GEMDOS, on passe des paramètres avec indication de la taille (L: pour un entier LONG, sinon W: par défaut).
En retour, ben on a une valeur en retour. On peut l'oublier en indiquant un VOID C: ou un ~C:.
Les options de compilation $C+ et $C- sont parfois nécessaire. Cela dépend du respect de la fonction appelée par rapport aux passages de paramètres. Bref, si le passage de paramètres est bizarroïde, utilisez ces options.

Bon, c'est bien joli, mais comment trouve-t-on l'adresse de cette fonction, hein ?

Réponse 1 : sûrement pas DTC, mais parfois dans un INLINE. Le plus souvent, le codeur GFA-68K stocke ses fonctions et bouts de programmes dans une zone mémoire du même programme GFA. Hop-ni-vu-ni-connu.

Réponse 2 : en fait, dans notre cas, la fonction est EXTERNE. Et l'on va demander au système où elle se trouve. Et comme d'habitude, ce sont dans la boîte à biscuits de mémé de Bagnières-de-Bigorre, heu... non pardon, c'est dans la boîte-à-cookies atari qu'on va la trouver.

Et comme votre serviteur vous sert bien, on vous redonne la fonction pour explorer la cookie-jar, même si vous l'avez eu la dernière fois.

FUNCTION test_cookie(cookie_name$,VAR cookie_valeur%)
LOCAL read_cook%,nom_cook%,cookie%
'
nom_cook%=CVL(cookie_name$)
cookie%=LPEEK(&H5A0)
cookie_valeur%=0
'
IF cookie%<>0
REPEAT
read_cook%=LPEEK(cookie%)
cookie_valeur%=LPEEK(ADD(cookie%,4))
ADD cookie%,8
UNTIL read_cook%=0 OR read_cook%=nom_cook%
IF read_cook%=nom_cook%
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
ELSE
RETURN FALSE
ENDIF
ENDFUNC

Gérer le TCP/IP
En fait, on va obtenir la présence ou non du cookie, et une valeur de retour. Cette valeur de retour est en fait un pointeur (=adresse) sur une structure, qui comporte divers renseignements, dont les adresses/pointeurs vers les fonctions que vous voulez utiliser dans votre marveilleux code GFA bien propre sur lui.

presence_sting!=@test_cookie("STiK", sting_pointeur%) ! ben oui, STinG est le fils légitime de STiK
Voilà la structure de STinG
typedef struct tpl {
char *module; /* Specific string that can be searched for */
char *author; /* Any string */
char *version; /* Format `00.00' Version:Revision */
char * cdecl (*KRmalloc) (int32);
void cdecl (*KRfree) (char *);
int32 cdecl (*KRgetfree) (int16 x);
char * cdecl (*KRrealloc) (char *, int32);
char * cdecl (*get_err_text) (int16);
char * cdecl (*getvstr) (char *);
int16 cdecl (*carrier_detect) (void);
int16 cdecl (*TCP_open) (uint32, int16, int16, uint16);
int16 cdecl (*TCP_close) (int16, int16);
int16 cdecl (*TCP_send) (int16, char *, int16);
int16 cdecl (*TCP_wait_state) (int16, int16, int16);
int16 cdecl (*TCP_ack_wait) (int16, int16);
int16 cdecl (*UDP_open) (uint32, int16);
int16 cdecl (*UDP_close) (int16);
int16 cdecl (*UDP_send) (int16, char *, int16);
int16 cdecl (*CNkick) (int16);
int16 cdecl (*CNbyte_count) (int16);
int16 cdecl (*CNget_char) (int16);
NDB * cdecl (*CNget_NDB) (int16);
int16 cdecl (*CNget_block) (int16, char *, int16);
void cdecl (*housekeep) (void);
int16 cdecl (*resolve) (char *, char **, uint32 *, int16);
void cdecl (*ser_disable) (void);
void cdecl (*ser_enable) (void);
int16 cdecl (*set_flag) (int16);
void cdecl (*clear_flag) (int16);
CIB * cdecl (*CNgetinfo) (int16);
int16 cdecl (*on_port) (char *port);
void cdecl (*off_port) (char *port);
int16 cdecl (*setvstr) (char *vs, char *value);
int16 cdecl (*query_port) (char *port);
int16 cdecl (*g_resolve)(char *dn, char **rdn, uint32 *adr_list, int16 lsize);
int16 cdecl (*g_TCP_wait_state)(int16 cn, int16 state, int16 timeout);
} TPL;
Oh, rassurez-vous, ce n'est pas bien méchant, et on ne pas pas tout utiliser. Dans votre code GFA, ça donnera ça :
FUNCTION stik_init
$F%
LOCAL stik_cookie_value%,stik_tpl%
'
IF @test_cookie("STiK",stik_cookie_value%)
IF stik_cookie_value%>0
IF MKL$(LONG{stik_cookie_value%})="STiK" AND MKL$(LONG{ADD(stik_cookie_value%,4)})="magi" AND BYTE{ADD(stik_cookie_value%,}=99 ! "STiKmagic"
'
stik_function_buffer%=@mxalloc_global(256,0) ! on créée aussi quelques zones mémoire en global, pour passer les chaines de texte via tcp_send
IF stik_function_buffer%<1
RETURN -6 ! can't malloc for sting
ENDIF
'
stik_get_dftab%=LONG{ADD(stik_cookie_value%,10)}
sitk_etm_exec%=LONG{ADD(stik_cookie_value%,14)}
stik_config%=LONG{ADD(stik_cookie_value%,18)}
stik_debug%=LONG{ADD(stik_cookie_value%,22)}
'
stik_tpl%=@stik_get_dftab("TRANSPORT_TCPIP")
IF stik_tpl%>0
'
tpl_module%=LONG{stik_tpl%}
tpl_author%=LONG{ADD(stik_tpl%,4)}
tpl_version%=LONG{ADD(stik_tpl%,}
kr_malloc%=LONG{ADD(stik_tpl%,12)}
kr_free%=LONG{ADD(stik_tpl%,16)}
kr_get_free%=LONG{ADD(stik_tpl%,20)}
kr_realloc%=LONG{ADD(stik_tpl%,24)}
tpl_get_error_text%=LONG{ADD(stik_tpl%,28)}
tpl_get_variable_string%=LONG{ADD(stik_tpl%,32)}
tpl_carrier_detect%=LONG{ADD(stik_tpl%,36)}
tcp_open%=LONG{ADD(stik_tpl%,40)}
tcp_close%=LONG{ADD(stik_tpl%,44)}
tcp_send%=LONG{ADD(stik_tpl%,48)}
tcp_wait_state%=LONG{ADD(stik_tpl%,52)}
tcp_ack_wait%=LONG{ADD(stik_tpl%,56)}
udp_open%=LONG{ADD(stik_tpl%,60)}
udp_close%=LONG{ADD(stik_tpl%,64)}
udp_send%=LONG{ADD(stik_tpl%,68)}
cn_kick%=LONG{ADD(stik_tpl%,72)}
cn_byte_count%=LONG{ADD(stik_tpl%,76)}
cn_get_char%=LONG{ADD(stik_tpl%,80)}
cn_get_ndb%=LONG{ADD(stik_tpl%,84)}
cn_get_block%=LONG{ADD(stik_tpl%,88)}
tpl_housekeep%=LONG{ADD(stik_tpl%,92)}
tpl_resolve%=LONG{ADD(stik_tpl%,96)}
ser_disable%=LONG{ADD(stik_tpl%,100)}
ser_enable%=LONG{ADD(stik_tpl%,104)}
tpl_set_flag%=LONG{ADD(stik_tpl%,108)}
tpl_clear_flag%=LONG{ADD(stik_tpl%,112)}
cn_get_info%=LONG{ADD(stik_tpl%,116)}
'
stik_client_ip%=LONG{stik_config%}
stik_provider%=LONG{ADD(stik_config%,4)}
stik_cn_time%=LONG{ADD(stik_config%,26)}
stik_cd_valid&=WORD{ADD(stik_config%,30)}
'
ELSE
RETURN -5 ! TCP layer not loaded
ENDIF
ELSE
RETURN -4 ! "STikmagic" not found
ENDIF
ELSE
RETURN -3 ! disabled?
ENDIF
ELSE
RETURN -2 ! cookie not found
ENDIF
RETURN 0 ! okay
ENDFUNC
Là, je vous laisse à l'étude de la librairie STiK pour GFA concoctée avec amour par Lonny Pursell (STiK DevKit 1.09, avec une doc STGUIDE remarquablement bien faite).
Vous pouvez également consulter les sources de Troll, Meg et le délicieux Litchi (à sucer sans modération) pour savoir comment on utilise les fonctions TCP/IP.
C'est plus facile que ça en a l'air, pas de panique.
En gros, pour le principe :
initialisations pour STiNG (savoir s'il est présent, et récupérer les adresses des fonctions)
tpl_resolve pour convertir une adresse littérale (ie www.multimania.com) en adresse IP.
tcp_open pour ouvrir un canal de communication avec le serveur distant, avec l'IP donnée par tpl_resolve.
tcp_wait_state pour attendre que le serveur daigne ouvrir la communication, si le timeout est dépassé, il faut alors gérer l'échec.
tcp_send pour envoyer des trucs, en général, c'est une commande telnet = texte en clair, selon les RFC (lisez bien les différentes RFCnnnn pop3, smtp, http, ftp ou mieux les sites web qui les ont traduites en tutoriels plus assimilables).
cn_byte_count et cn_get_char pour récupérer la réponse. La difficulté est qu'on ne connait pas souvent la taille de la réponse, avoir une bonne dextérité sur les manipulations mémoire est souhaitable.
tcp_close pour fermer le canal, quand vous ne voulez plus dialoguer avec le serveur.
Notez que le principe est en fait pour un CLIENT tcp/ip. Vous pouvez aussi vous comporter en SERVEUR tcp/ip, avec un paramètre 0 à indiquer dans tcp_open, mais là, c'est Terra Incognita : pas d'expérience dessus. Et il faut avoir une machine puissante/rapide pour gérer le service, et pouvoir répondre à n'importe quel moment à X sollicitations. La gestion du temps est primordiale quand on doit être un serviteur.

Utiliser une librairie dynamique GEM = LDG
Même principe, on va fouiller dans la cookie-jar pour trouver les bonnes adresses. Attention ici, car il existe une autre méthode, celle du linkage, qui permet un programme en C d'appeler directement les fonctions LDG. Pas de pot ici, on doit passer par le cookie, et donc d'installer le LDG.PRG dans le dossier AUTO. Une fois cette installation faite, on peut avoir cela :

PROCEDURE ldg_init
'
ldgm_cookie!=@test_cookie("LDGM",ldg_cookie_ptr%)
IF ldgm_cookie!=TRUE AND ldg_cookie_ptr%>0
'
ldg_version&=INT{ldg_cookie_ptr%}
ldg_path$=CHAR{ADD(ldg_cookie_ptr%,2)}
ldg_gc_time&=INT{ADD(ldg_cookie_ptr%,130)}
'
ldg_open%=LONG{ADD(ldg_cookie_ptr%,134)}
ldg_close%=LONG{ADD(ldg_cookie_ptr%,138)}
ldg_find%=LONG{ADD(ldg_cookie_ptr%,142)}
ldg_error%=ADD(ldg_cookie_ptr%,150)
'
ELSE
ldg_version&=0
ldg_path$=""
ldg_gc_time&=0
'
ldg_open%=0
ldg_close%=0
ldg_find%=0
ldg_error%=0
ENDIF
'
RETURN
ldg_open pour ouvrir la librairie (et la charger, le cas échéant, à partir du dossier C:\GEMSYS\LDG\)
ldg_close pour fermer tout proprement quand on a fini.
ldg_find pour obtenir l'adresse de la fonction voulue, grâve à son nom
Vous notez qu'on passe par une double étape : d'abord charger la librairie, PUIS on va récupérer les adresses.
Si le développeur de la librairie (par exemple la DEFLATE.LDG de votre humble serviteur) a fait son taf correctement, les fonctions de sa librairie sont documentées. Il suffit d'utiliser un outil du pack LDG, ou même le LDG.CPX pour savoir quelle fonction est présente et savoir quels paramètres lui passer.

Dans le cas du DEFLATE, voici les prototypages :

const char* CDECL get_version();
const char* CDECL get_info();
const char* CDECL get_error(int err);
unsigned long CDECL get_compil_flags();
unsigned long CDECL get_sizeof_stream_struct();

int CDECL raw_deflate_init (z_stream *strm, int level);
int CDECL raw_deflate (z_stream *strm, int flush);
int CDECL raw_deflate_end (z_stream *strm);

int CDECL raw_inflate_init (z_stream *strm);
int CDECL raw_inflate (z_stream *strm, int flush);
int CDECL raw_inflate_end (z_stream *strm);

unsigned long CDECL update_crc32(uLong crc_value, const Bytef *buf, uInt len);
Pour les trouver en GFA, cela donne :
FUNCTION zlib_open
$F%
'
zlib_get_version%=0
zlib_get_info%=0
zlib_get_error%=0
zlib_get_compil_flags%=0
zlib_get_sizeof_stream_struct%=0
'
zlib_deflate_init%=0
zlib_deflate%=0
zlib_deflate_end%=0
'
zlib_inflate_init%=0
zlib_inflate%=0
zlib_inflate_end%=0
'
zlib_crc%=0
'
ldg_mem_malloc_ptr%=0
ldg_mem_free_ptr%=0
'
IF shell_buf%>0 AND ldg_open%>0
zlib_error&=0
'
CHAR{shell_buf%}="deflate.ldg" ! on place notre chaine de texte dans une zone mémoire en global
'
zlib_ldg_ptr%=C:ldg_open%(L:shell_buf%,L:global%) !!! on charge
IF zlib_ldg_ptr%<1
zlib_error&=INT{ldg_error%}
'
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_version"
'
zlib_get_version%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%) !! et on cherche
IF zlib_get_version%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_info"
'
zlib_get_info%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_info%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_error"
'
zlib_get_error%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_error%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_compil_flags"
'
zlib_get_compil_flags%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_compil_flags%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="get_sizeof_stream_struct"
'
zlib_get_sizeof_stream_struct%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_get_sizeof_stream_struct%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_deflate_init"
'
zlib_deflate_init%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_deflate_init%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_deflate"
'
zlib_deflate%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_deflate%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_deflate_end"
'
zlib_deflate_end%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_deflate_end%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_inflate_init"
'
zlib_inflate_init%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_inflate_init%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_inflate"
'
zlib_inflate%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_inflate%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="raw_inflate_end"
'
zlib_inflate_end%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_inflate_end%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="update_crc32"
'
zlib_crc%=C:ldg_find%(L:shell_buf%,L:zlib_ldg_ptr%)
IF zlib_crc%=0
RETURN FALSE
ENDIF
'
CHAR{shell_buf%}="mem.ldg"
'
ldg_mem_ptr%=C:ldg_open%(L:shell_buf%,L:global%)
IF ldg_mem_ptr%>0
'
CHAR{shell_buf%}="ldg_malloc"
'
ldg_mem_malloc_ptr%=C:ldg_find%(L:shell_buf%,L:ldg_mem_ptr%)
'
CHAR{shell_buf%}="ldg_free"
'
ldg_mem_free_ptr%=C:ldg_find%(L:shell_buf%,L:ldg_mem_ptr%)
'
ENDIF
'
RETURN TRUE
ENDIF
RETURN FALSE
ENDFUNC
Remarques :
Vous noterez le préfixe zlib. Ben oui, j'ai honteusement adapté la zlib pour l'utilisation. Cf les sources de KK Commander, les manipulations se sont faites dans Xcode sous MacOSX, en cross-compilation atari-mint-68k. Me demandez pas comment ça marche, ça marche.
on utilise le DEFLATE.LDG, mais aussi le MEM.LDG, car la zlib demande une zone mémoire, ou plutôt des adresses de fonctions qui vont permettre d'allouer de la mémoire. Ces informations seront passés via une structure nommée zstream.
global% est contient une valeur spéciale de notre programme : global%=LONG{ADD(GB,4)} qu'on écrit au début de ses initialisations.
Vous noterez que le DEFLATE.LDG ne contient que des fonctions de compression et décompresion (et aussi vérification CRC32).
En fait, le PKZIP est tout à fait gérable en GFA pur (et mon code GFA le gère en natif), mais sans compression. Un PKZIP est en fait une liste de structures, avec à côté des fichiers compressés, ou pas. On dit "encapsuler", c'est-à-dire qu'on place une ou plusieurs choses (ici des fichiers, traités ou non par compression et/ou cryptage) dans un contenant (qui sera lui-même un fichier).
Vu que le GFA est un peu faible niveau traitement, on externalise les fonctions qui demandent du calcul, comme la compression/décompression, dans une librairie codée en C, déjà écrite, comme la zlib.
Ici, la librairie va s'occuper de l'algorithme de compression nommé DEFLATE (dégrossir, compresser), et son contraire, INFLATE (grossir, décompresser).

La documentation officielle du PKZIP se trouve chez PKware.

Je vous renvoie aux sources de KK Commander, pour une gestion de .ZIP complète, et vers Crésus, pour une version allégée, qui crée un .ZIP de novo, puis ajoute les fichiers un par un, dans l'optique d'archivage. D'ailleurs, j'ai eu assez de mojo pour en faire un programme exemple à part, merci de voir dans le dossier bonux. A vous d'adapter le BIG_ZEE.GFA à vos besoins, si votre application de-la-mort-qui-tue a besoin de quelques fonctions d'archivage.
A noter que vous ne comprendez pas grand chose au code si vous n'avez pas lu d'abord la documentation de PKware. Une fois le APPNOTE.TXT lu de long en large et prêt à le réciter de mémoire (Shakespeare, c'est mieux mais on va pas en faire un programme), alors cela deviendra limpide. Quelques remarques cependant :

les valeurs dans le fichier zip sont au format Intel et pas motorola, donc des petites conversions à faire.
les séparateurs dans les chemins sont des slashs / au lieu des antislashs \ du TOS/MSDOS.
chaque fichier dans le zip se nomme une zip_entry, une "entrée" zip.
la liste de structures décrivant les fichiers, leur compression ou non, leur taille, leur valeur crc32 de vérification, leur position dans le fichier se trouve en fin de fichier zip. Cela paraît bizarre, mais ça facilite le rajout des fichiers.
chaque structure a un identifiant sur 4 octets, qui permet de la typer.

Le mot de la fin
Heu, j'aillais dire "à la prochaine !", mais vu l'âge avancé du capitaine qui mérite bien sa retraite, on dira : "Tchuss".


Rajah Lone
écrit en 2009